1 |
8 |
ahitrov@rambler.ru |
package @NAME@::State; |
2 |
|
|
|
3 |
|
|
# ---------------------------------------------------------------------------- |
4 |
|
|
# Состояние проекта @NAME@. |
5 |
|
|
# В этом пакете обязательно должны быть методы new(), info(). |
6 |
|
|
# |
7 |
|
|
# При создании объекта Contenido::State будет создан также объект |
8 |
|
|
# класса @NAME@::State. Он будет доступен (этот метод вернет объект) |
9 |
|
|
# через метод, имеющий имя равное результату выполнения следующего |
10 |
|
|
# фрагмента perl-кода: lc('@NAME@'). |
11 |
|
|
# ---------------------------------------------------------------------------- |
12 |
|
|
|
13 |
|
|
use strict; |
14 |
|
|
use vars qw($VERSION $AUTOLOAD); |
15 |
|
|
$VERSION = '1.0'; |
16 |
|
|
|
17 |
|
|
sub new { |
18 |
|
|
my ($proto) = @_; |
19 |
|
|
my $class = ref($proto) || $proto; |
20 |
|
|
my $self = {}; |
21 |
|
|
bless($self, $class); |
22 |
|
|
|
23 |
|
|
## Далее настройки проекта на основе переменных из config.mk в виде: |
24 |
|
|
## $self->{variable_name} = 'VARIABLE_NAME_SURROUNDED_BY_@@'; |
25 |
|
|
|
26 |
|
|
$self->{contenido_notab} = 1; |
27 |
|
|
|
28 |
|
|
$self->_init_(); |
29 |
|
|
|
30 |
|
|
return $self; |
31 |
|
|
} |
32 |
|
|
|
33 |
|
|
# Вывод информации об объекте... |
34 |
|
|
sub info |
35 |
|
|
{ |
36 |
|
|
my $self = shift; |
37 |
|
|
return undef unless ref($self); |
38 |
|
|
|
39 |
|
|
warn "Contenido: Объект @NAME@::State заполнен следующими параметрами:\n"; |
40 |
|
|
foreach my $attribute (sort (keys( %{ $self->{attributes} } ))) |
41 |
|
|
{ |
42 |
|
|
my $la = length($attribute); |
43 |
|
|
warn "\t".$attribute.("\t" x (2-int($la/8))).": ".$self->{$attribute}."\n"; |
44 |
|
|
} |
45 |
|
|
} |
46 |
|
|
|
47 |
|
|
|
48 |
|
|
# Инициализация. |
49 |
|
|
# - Создает внутри объекта хэш с типами полей - это нужно для быстрой |
50 |
|
|
# работы метода AUTOLOAD... |
51 |
|
|
sub _init_ |
52 |
|
|
{ |
53 |
|
|
my $self = shift; |
54 |
|
|
|
55 |
|
|
## Здесь список параметров, указанных в new() |
56 |
|
|
foreach my $attribute ( qw( |
57 |
|
|
contenido_notab |
58 |
|
|
) ) |
59 |
|
|
{ |
60 |
|
|
$self->{attributes}->{ $attribute } = 'SCALAR'; |
61 |
|
|
} |
62 |
|
|
} |
63 |
|
|
|
64 |
|
|
|
65 |
|
|
# ---------------------------------------------------------------------------- |
66 |
|
|
# Это умный AUTOLOAD. Ловит методов для установки/чтения полей... |
67 |
|
|
# Версия 0.2 |
68 |
|
|
# ---------------------------------------------------------------------------- |
69 |
|
|
sub AUTOLOAD |
70 |
|
|
{ |
71 |
|
|
my $self = shift; |
72 |
|
|
my $attribute = $AUTOLOAD; |
73 |
|
|
|
74 |
|
|
$attribute =~ s/.*:://; |
75 |
|
|
return undef unless $attribute =~ /[^A-Z]/; # Отключаем методы типа DESTROY |
76 |
|
|
|
77 |
|
|
if (! exists($self->{attributes}->{$attribute})) |
78 |
|
|
{ |
79 |
|
|
warn "Contenido Error (@NAME@::State): Вызов метода, для которого не существует обрабатываемого свойства: ->$attribute()\n"; |
80 |
|
|
return undef; |
81 |
|
|
} |
82 |
|
|
|
83 |
|
|
$self->{ $attribute } = shift @_ if (scalar(@_) > 0); |
84 |
|
|
return $self->{ $attribute }; |
85 |
|
|
} |
86 |
|
|
|
87 |
|
|
|
88 |
|
|
1; |