Mercurial > pub > Impl

comparison Lib/IMPL/Class/Meta.pm @ 229:47f77e6409f7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
heavily reworked the resource model of the web application: *some ResourcesContraact functionality moved to Resource +Added CustomResource *Corrected action handlers
author sergey
date Sat, 29 Sep 2012 02:34:47 +0400
parents a8db61d0ed33
children 6d8092d8ce1b
comparison
equal deleted inserted replaced
228:431db7034a88 229:47f77e6409f7
67 } 67 }
68 } 68 }
69 } 69 }
70 70
71 sub static_accessor { 71 sub static_accessor {
72 my ($class,$name,$value,$clone) = @_; 72 my ($class,$name,$value,$inherit) = @_;
73
74 $inherit ||= 'inherit';
75
76 my $method = "static_accessor_$inherit";
77
78 return $class->$method($name,$value);
79 }
80
81 sub static_accessor_clone {
82 my ($class,$name,$value) = @_;
73 $class = ref $class || $class; 83 $class = ref $class || $class;
74 84
75 no strict 'refs'; 85 no strict 'refs';
76 86
77 *{"${class}::${name}"} = sub { 87 *{"${class}::${name}"} = sub {
79 89
80 if (@_ > 0) { 90 if (@_ > 0) {
81 $self = ref $self || $self; 91 $self = ref $self || $self;
82 92
83 if ($class ne $self) { 93 if ($class ne $self) {
84 $self->static_accessor( $name => $_[0] ); # define own class data 94 $self->static_accessor_clone( $name => $_[0] ); # define own class data
85 } else { 95 } else {
86 $value = $_[0]; 96 $value = $_[0];
87 } 97 }
88 } else { 98 } else {
89 ($clone and $class ne $self) 99 $self->static_accessor_clone($name => clone($value));
90 ? $self->static_accessor($name => clone($value),$clone)
91 : $value and $value ;
92 } 100 }
93 }; 101 };
94 $value 102 $value
95 }; 103 };
104
105 sub static_accessor_inherit {
106 my ($class,$name,$value) = @_;
107
108 no strict 'refs';
109
110 *{"${class}::$name"} = sub {
111 my $self = shift;
112
113 if (@_ > 0) {
114 $self = ref $self || $self;
115
116 if ($class ne $self) {
117 $self->static_accessor_inherit( $name => $_[0] ); # define own class data
118 } else {
119 $value = $_[0];
120 }
121 } else {
122 $value ;
123 }
124 }
125 }
126
127 sub static_accessor_own {
128 my ($class,$name,$value) = @_;
129
130 no strict 'refs';
131
132 *{"${class}::$name"} = sub {
133 my $self = shift;
134
135 if ($class ne $self) {
136 if (@_ > 0) {
137 $self->static_accessor_own( $name => $_[0] ); # define own class data
138 } else {
139 return;
140 }
141 } else {
142 if ( @_ > 0 ) {
143 $value = $_[0];
144 } else {
145 return $value;
146 }
147 }
148 }
149 }
96 150
97 sub _find_class_data { 151 sub _find_class_data {
98 my ($class,$name) = @_; 152 my ($class,$name) = @_;
99 153
100 no strict 'refs'; 154 no strict 'refs';
211 265
212 Осуществлять поиск по базовым классам. 266 Осуществлять поиск по базовым классам.
213 267
214 =back 268 =back
215 269
216 =head2 C<static_accessor($name[,$value[,$clone]])> 270 =head2 C<static_accessor($name[,$value[,$inherit]])>
217 271
218 Создает статическое свойство с именем C<$name> и начальным значением C<$value>. 272 Создает статическое свойство с именем C<$name> и начальным значением C<$value>.
219 273
220 Параметр C<$clone> контролирует то, как наследуются значения, если требуется каждому классу обеспечить 274 Параметр C<$inherit> контролирует то, как наследуются значения.
221 свое уникальное значение, то при первом обращении оно будет клонировано, по умолчанию клонирование не 275
222 происходит. 276 =over
277
278 =item * C<inherit>
279
280 По умолчанию. Означает, что если для класса не определено значение, оно будет
281 получено от родителя.
282
283 =item * C<clone>
284
285 Если для класса не определено значение, то оно будет клонировано из
286 родительского значения при первом обращении. Полезно, когда родитель задает
287 значение по-умолчанию, которое разделяется между несколькими потомками,
288 которые модифицирю само значение (например значением является ссылка на хеш,
289 а потомки добавляют или меняют значения в этом хеше).
290
291 =item * C<own>
292
293 Каждый класс имеет свое собственное значение не зависящее от того, что было
294 у предка. Начальное значение для этого статического свойства C<undef>.
295
296 =back
297
298 Данный метод является заглушкой, он передает управление
299 C<static_accessor_inherit>, C<static_accessor_clone>, C<static_accessor_own>
300 соответственно. Эти методы можно вызывать явно
301 C<static_accessor_*($name[,$value])>.
302
223 303
224 =begin code 304 =begin code
225 305
226 package Foo; 306 package Foo;
227 use parent qw(IMPL::Class::Meta); 307 use parent qw(IMPL::Class::Meta);
228 308
229 __PACKAGE__->static_accessor( info => { version => 1 } ); 309 __PACKAGE__->static_accessor( info => { version => 1 } );
310 __PACKAGE__->static_accessor( mappings => { toString => \&ToString }, 'clone' );
311 __PACKAGE__->static_accessor( _instance => undef, 'own' );
312
313 sub ToString {
314 "[object Foo]";
315 }
316
317 sub default {
318 my ($self) = @_;
319
320 $self = ref $self || $self;
321 return $self->_instance ? $self->_instance : $self->_instance($self->new());
322 }
230 323
231 package Bar; 324 package Bar;
232 use parent qw(Foo); 325 use parent qw(Foo);
233 326
234 __PACKAGE__->info->{language} = 'English'; # Foo->info->{language} will become 'English' to!!! 327 __PACKAGE__->info({language => 'English', version => 2}); # will define own 'info' but will loose original data.
235 __PACKAGE__->info({language => 'English'}); # will define own 'info' but will loose original data. 328 __PACKAGE__->mappings->{sayHello} = \&SayHello; # will not affect Foo->mappings;
329
330 package main;
331
332 my $foo = Foo->default; # will be a Foo object
333 my $bar = Bar->default; # will be a Bar object
236 334
237 =end code 335 =end code
238 336
239 =cut 337 =cut