Line # Revision Author
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;