Mercurial > pub > Impl

comparison Lib/IMPL/Class/Meta.pm @ 194:4d0e1962161c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents d1676be8afcc
children a8db61d0ed33
comparison
equal deleted inserted replaced
193:8e8401c0aea4 194:4d0e1962161c
34 } 34 }
35 wantarray ? @result : \@result; 35 wantarray ? @result : \@result;
36 } 36 }
37 37
38 sub class_data { 38 sub class_data {
39 my $class = shift; 39 my $class = shift;
40 $class = ref $class || $class; 40 $class = ref $class || $class;
41 41
42 if (@_ > 1) { 42 if (@_ > 1) {
43 my ($name,$value) = @_; 43 my ($name,$value) = @_;
44 return $class_data{$class}{$name} = $value; 44 return $class_data{$class}{$name} = $value;
45 } else { 45 } else {
46 my ($name) = @_; 46 my ($name) = @_;
47 47
48 if( exists $class_data{$class}{$name} ) { 48 if( exists $class_data{$class}{$name} ) {
49 $class_data{$class}{$name}; 49 $class_data{$class}{$name};
50 } else { 50 } else {
51 if ( my $value = $class->_find_class_data($name) ) { 51 if ( my $value = $class->_find_class_data($name) ) {
52 $class_data{$class}{$name} = clone($value); 52 $class_data{$class}{$name} = clone($value);
53 } else { 53 } else {
54 undef; 54 undef;
55 } 55 }
56 } 56 }
57 } 57 }
58 } 58 }
59 59
60 sub static_accessor { 60 sub static_accessor {
61 my ($class,$name,$value) = @_; 61 my ($class,$name,$value) = @_;
62 $class = ref $class || $class; 62 $class = ref $class || $class;
63 63
64 no strict 'refs'; 64 no strict 'refs';
65 65
66 *{"${class}::${name}"} = sub { 66 *{"${class}::${name}"} = sub {
67 if (@_ > 1) { 67 if (@_ > 1) {
68 my $self = shift; 68 my $self = shift;
69 $self = ref $self || $self; 69 $self = ref $self || $self;
70 70
71 if ($class ne $self) { 71 if ($class ne $self) {
72 $self->static_accessor( $name => $_[0]); # define own class data 72 $self->static_accessor( $name => $_[0]); # define own class data
73 } else { 73 } else {
74 $value = $_[0]; 74 $value = $_[0];
75 } 75 }
76 } else { 76 } else {
77 $value; 77 $value;
78 } 78 }
79 }; 79 };
80 $value 80 $value
81 }; 81 };
82 82
83 sub _find_class_data { 83 sub _find_class_data {
84 my ($class,$name) = @_; 84 my ($class,$name) = @_;
85 85
86 no strict 'refs'; 86 no strict 'refs';
87 87
88 exists $class_data{$_}{$name} and return $class_data{$_}{$name} foreach @{"${class}::ISA"}; 88 exists $class_data{$_}{$name} and return $class_data{$_}{$name} foreach @{"${class}::ISA"};
89 89
90 my $val; 90 my $val;
91 $val = $_->can('_find_class_data') ? $_->_find_class_data($name) : undef and return $val foreach @{"${class}::ISA"}; 91 $val = $_->can('_find_class_data') ? $_->_find_class_data($name) : undef and return $val foreach @{"${class}::ISA"};
92 } 92 }
93 93
94 1; 94 1;
95 95
96 __END__ 96 __END__
111 use IMPL::Class::Property; 111 use IMPL::Class::Property;
112 112
113 __PACKAGE__->PassThroughArgs; 113 __PACKAGE__->PassThroughArgs;
114 114
115 BEGIN { 115 BEGIN {
116 public property name => prop_get | owner_set; 116 public property name => prop_get | owner_set;
117 } 117 }
118 118
119 package InfoExMeta; 119 package InfoExMeta;
120 use parent qw(InfoMeta); 120 use parent qw(InfoMeta);
121 121
122 __PACKAGE__->PassThroughArgs; 122 __PACKAGE__->PassThroughArgs;
123 123
124 BEGIN { 124 BEGIN {
125 public property description => prop_all; 125 public property description => prop_all;
126 } 126 }
127 127
128 package Foo; 128 package Foo;
129 129
130 __PACKAGE__->set_meta(new InfoMeta(name => 'info')); 130 __PACKAGE__->set_meta(new InfoMeta(name => 'info'));
177 метаданные как не подходящие. Также переменная C<$_> ссылается на текущий объект с метаданными. 177 метаданные как не подходящие. Также переменная C<$_> ссылается на текущий объект с метаданными.
178 178
179 =begin code 179 =begin code
180 180
181 my @info = Foo->get_meta( 181 my @info = Foo->get_meta(
182 'InfoMeta', 182 'InfoMeta',
183 sub { ref $_ eq 'InfoMeta'}, # exclude subclasses ('InfoExMeta') 183 sub { ref $_ eq 'InfoMeta'}, # exclude subclasses ('InfoExMeta')
184 1 # deep search 184 1 # deep search
185 ); 185 );
186 186
187 my @info = Foo->get_meta( 187 my @info = Foo->get_meta(
188 'InfoMeta', 188 'InfoMeta',
189 sub { 189 sub {
190 my $item = shift; 190 my $item = shift;
191 ref $item eq 'InfoMeta' # exclude subclasses ('InfoExMeta') 191 ref $item eq 'InfoMeta' # exclude subclasses ('InfoExMeta')
192 }, 192 },
193 1 # deep search 193 1 # deep search
194 ); 194 );
195 195
196 =end code 196 =end code
197 197
198 =item C<$deep> 198 =item C<$deep>
218 use parent qw(IMPL::Class::Meta); 218 use parent qw(IMPL::Class::Meta);
219 219
220 __PACKAGE__->class_data( info => { version => 1 } ); # will be default for all subclasses 220 __PACKAGE__->class_data( info => { version => 1 } ); # will be default for all subclasses
221 221
222 sub say_version { 222 sub say_version {
223 my ($self) = @_; 223 my ($self) = @_;
224 224
225 print $self->class_data('info')->{version}; 225 print $self->class_data('info')->{version};
226 } 226 }
227 227
228 package Bar; 228 package Bar;
229 use parent qw(Foo); 229 use parent qw(Foo);
230 230