annotate Lib/IMPL/Class/Meta.pm @ 284:f2a6bc5f3184

+IMPL::Object::InlineFactory: implement object factory as subroutine
author sergey
date Thu, 14 Feb 2013 19:14:02 +0400
parents c6d0f889ef87
children 7c784144d2f1
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
1 package IMPL::Class::Meta;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
2 use strict;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
3
279
sergey
parents: 263
diff changeset
4 use Carp qw(carp confess);
173
aaab45153411 minor bugfixes
sourcer
parents: 171
diff changeset
5 use IMPL::clone qw(clone);
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
6
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
7 my %class_meta;
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
8 my %class_data;
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
9
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
10 sub SetMeta {
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
11 my ($class,$meta_data) = @_;
279
sergey
parents: 263
diff changeset
12 $class = ref $class || $class;
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
13
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
14 # тут нельзя использовать стандартное исключение, поскольку для него используется
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
15 # класс IMPL::Object::Accessor, который наследуется от текущего класса
279
sergey
parents: 263
diff changeset
16 confess "The meta_data parameter should be an object" if not ref $meta_data;
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
17
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
18 push @{$class_meta{$class}{ref $meta_data}},$meta_data;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
19 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
20
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
21 sub set_meta {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
22 goto &SetMeta;
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
23 }
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
24
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
25 sub GetMeta {
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
26 my ($class,$meta_class,$predicate,$deep) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
27 $class = ref $class if ref $class;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
28 no strict 'refs';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
29 my @result;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
30
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
31 if ($deep) {
280
c6d0f889ef87 +IMPL::declare now supports meta attributes
cin
parents: 279
diff changeset
32 @result = map { $_->can('GetMeta') ? $_->GetMeta($meta_class,$predicate,$deep) : () } @{$class.'::ISA'};
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
33 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
34
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
35 if ($predicate) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
36 push @result,grep( &$predicate($_), map( @{$class_meta{$class}{$_}}, grep( $_->isa($meta_class), keys %{$class_meta{$class} || {}} ) ) );
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
37 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
38 push @result, map( @{$class_meta{$class}{$_} || []}, grep( $_->isa($meta_class), keys %{$class_meta{$class} || {}} ) );
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
39 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
40 wantarray ? @result : \@result;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
41 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
42
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
43 sub get_meta {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
44 goto &GetMeta;
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
45 }
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
46
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
47 sub class_data {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
48 my $class = shift;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
49 $class = ref $class || $class;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
50
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
51 carp 'The method is obsolete, use static_accessor($name,$value,\'clone\') instead';
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
52
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
53 if (@_ > 1) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
54 my ($name,$value) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
55 return $class_data{$class}{$name} = $value;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
56 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
57 my ($name) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
58
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
59 if( exists $class_data{$class}{$name} ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
60 $class_data{$class}{$name};
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
61 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
62 if ( my $value = $class->_find_class_data($name) ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
63 $class_data{$class}{$name} = clone($value);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
64 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
65 undef;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
66 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
67 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
68 }
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
69 }
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
70
163
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
71 sub static_accessor {
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
72 my ($class,$name,$value,$inherit) = @_;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
73
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
74 $inherit ||= 'inherit';
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
75
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
76 my $method = "static_accessor_$inherit";
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
77
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
78 return $class->$method($name,$value);
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
79 }
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
80
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
81 sub static_accessor_clone {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
82 my ($class,$name,$value) = @_;
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
83 $class = ref $class || $class;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
84
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
85 no strict 'refs';
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
86
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
87 *{"${class}::${name}"} = sub {
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
88 my $self = shift;
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
89
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
90 $self = ref $self || $self;
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
91
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
92 if (@_ > 0) {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
93 if ($class ne $self) {
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
94 $self->static_accessor_clone( $name => $_[0] ); # define own class data
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
95 } else {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
96 $value = $_[0];
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
97 }
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
98 } else {
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
99 return $self ne $class
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
100 ? $self->static_accessor_clone($name => clone($value))
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
101 : $value;
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
102 }
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
103 };
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
104 return $value;
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
105 };
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
106
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
107 sub static_accessor_inherit {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
108 my ($class,$name,$value) = @_;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
109
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
110 no strict 'refs';
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
111
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
112 *{"${class}::$name"} = sub {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
113 my $self = shift;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
114
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
115 if (@_ > 0) {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
116 $self = ref $self || $self;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
117
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
118 if ($class ne $self) {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
119 $self->static_accessor_inherit( $name => $_[0] ); # define own class data
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
120 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
121 $value = $_[0];
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
122 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
123 } else {
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
124 $value ;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
125 }
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
126 };
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
127 return $value;
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
128 }
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
129
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
130 sub static_accessor_own {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
131 my ($class,$name,$value) = @_;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
132
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
133 no strict 'refs';
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
134
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
135 *{"${class}::$name"} = sub {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
136 my $self = shift;
263
0f59b2de72af *fixed IMPL::DOM::Schema circular module references
sergey
parents: 230
diff changeset
137 $self = ref $self || $self;
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
138
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
139 if ($class ne $self) {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
140 if (@_ > 0) {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
141 $self->static_accessor_own( $name => $_[0] ); # define own class data
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
142 } else {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
143 return;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
144 }
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
145 } else {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
146 if ( @_ > 0 ) {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
147 $value = $_[0];
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
148 } else {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
149 return $value;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
150 }
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
151 }
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
152 };
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
153
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
154 return $value;
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
155 }
163
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
156
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
157 sub _find_class_data {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
158 my ($class,$name) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
159
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
160 no strict 'refs';
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
161
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
162 exists $class_data{$_}{$name} and return $class_data{$_}{$name} foreach @{"${class}::ISA"};
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
163
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
164 my $val;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
165 $val = $_->can('_find_class_data') ? $_->_find_class_data($name) : undef and return $val foreach @{"${class}::ISA"};
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
166 }
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
167
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
168 1;
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
169
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
170 __END__
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
171
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
172 =pod
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
173
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
174 =head1 NAME
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
175
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
176 C<IMPL::Class::Meta> - информация хранимая на уровне класса.
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
177
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
178 =head1 SYNOPSIS
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
179
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
180 =begin code
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
181
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
182 package InfoMeta;
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
183
165
76515373dac0 Added Class::Template,
wizard
parents: 164
diff changeset
184 use parent qw(IMPL::Object IMPL::Object::Autofill);
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
185 use IMPL::Class::Property;
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
186
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
187 __PACKAGE__->PassThroughArgs;
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
188
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
189 BEGIN {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
190 public property name => prop_get | owner_set;
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
191 }
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
192
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
193 package InfoExMeta;
165
76515373dac0 Added Class::Template,
wizard
parents: 164
diff changeset
194 use parent qw(InfoMeta);
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
195
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
196 __PACKAGE__->PassThroughArgs;
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
197
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
198 BEGIN {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
199 public property description => prop_all;
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
200 }
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
201
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
202 package Foo;
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
203
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
204 __PACKAGE__->set_meta(new InfoMeta(name => 'info'));
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
205 __PACKAGE__->set_meta(new InfoExMeta(name => 'infoEx', description => 'extended info' ));
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
206
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
207 package main;
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
208
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
209 # get all InfoMeta, InfoExMeta will be included, becouse it's derived from InfoMeta
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
210 my @info = Foo->get_meta('InfoMeta'); # will get two objects, 'info' and 'infoEx';
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
211
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
212 # get all InfoExMeta meta
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
213 @info = Foo->get_meta('InfoExMeta'); # will get only 'infoEx'
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
214
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
215 # get filtered meta
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
216 @info = Foo->get_meta('InfoMeta', sub { $_->name eq 'info'} ); # will get only 'info'
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
217
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
218 =end code
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
219
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
220 =head1 DESCRIPTION
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
221
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
222 Позвоялет расширять информацию о типах (класса) при помощи метаданных, метаданными являются любые объекты,
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
223 притом выборка метаданных приоизводится по их типу (классу), что позволяет выбрать все однотипные метаданные.
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
224
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
225 Существует возможность выборки метаданных с учетом унаследованных от базовых классов
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
226
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
227 =head1 MEMBERS
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
228
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
229 =head2 C<set_meta($meta_data)>
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
230
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
231 Добавляет метаданные C<$meta_data> к классу.
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
232
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
233 =head2 C<get_meta($meta_class,$predicate,$deep)>
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
234
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
235 Выбирает метаданные типа C<$meta_class> и его наследников, с возможностью фильтрации и получения
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
236 метаданных базовых классов.
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
237
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
238 =over
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
239
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
240 =item C<$meta_class>
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
241
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
242 Тип метаданных
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
243
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
244 =item C<$predicate>
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
245
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
246 Подпрограмма, которая будет вызываться для каждых найденных метаданных и на основе результата
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
247 ее выполнения метаданные будут включены в результат или нет. Получеат в качестве параметра
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
248 объект с метаданными, возвращает C<true> - включить метаданные в результа, C<false> - пропустить
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
249 метаданные как не подходящие. Также переменная C<$_> ссылается на текущий объект с метаданными.
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
250
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
251 =begin code
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
252
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
253 my @info = Foo->get_meta(
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
254 'InfoMeta',
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
255 sub { ref $_ eq 'InfoMeta'}, # exclude subclasses ('InfoExMeta')
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
256 1 # deep search
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
257 );
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
258
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
259 my @info = Foo->get_meta(
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
260 'InfoMeta',
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
261 sub {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
262 my $item = shift;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
263 ref $item eq 'InfoMeta' # exclude subclasses ('InfoExMeta')
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
264 },
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
265 1 # deep search
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
266 );
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
267
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
268 =end code
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
269
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
270 =item C<$deep>
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
271
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
272 Осуществлять поиск по базовым классам.
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
273
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
274 =back
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
275
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
276 =head2 C<static_accessor($name[,$value[,$inherit]])>
163
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
277
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
278 Создает статическое свойство с именем C<$name> и начальным значением C<$value>.
163
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
279
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
280 Параметр C<$inherit> контролирует то, как наследуются значения.
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
281
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
282 =over
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
283
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
284 =item * C<inherit>
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
285
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
286 По умолчанию. Означает, что если для класса не определено значение, оно будет
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
287 получено от родителя.
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
288
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
289 =item * C<clone>
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
290
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
291 Если для класса не определено значение, то оно будет клонировано из
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
292 родительского значения при первом обращении. Полезно, когда родитель задает
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
293 значение по-умолчанию, которое разделяется между несколькими потомками,
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
294 которые модифицирю само значение (например значением является ссылка на хеш,
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
295 а потомки добавляют или меняют значения в этом хеше).
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
296
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
297 =item * C<own>
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
298
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
299 Каждый класс имеет свое собственное значение не зависящее от того, что было
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
300 у предка. Начальное значение для этого статического свойства C<undef>.
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
301
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
302 =back
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
303
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
304 Данный метод является заглушкой, он передает управление
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
305 C<static_accessor_inherit>, C<static_accessor_clone>, C<static_accessor_own>
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
306 соответственно. Эти методы можно вызывать явно
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
307 C<static_accessor_*($name[,$value])>.
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
308
163
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
309
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
310 =begin code
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
311
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
312 package Foo;
165
76515373dac0 Added Class::Template,
wizard
parents: 164
diff changeset
313 use parent qw(IMPL::Class::Meta);
163
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
314
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
315 __PACKAGE__->static_accessor( info => { version => 1 } );
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
316 __PACKAGE__->static_accessor( mappings => { toString => \&ToString }, 'clone' );
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
317 __PACKAGE__->static_accessor( _instance => undef, 'own' );
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
318
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
319 sub ToString {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
320 "[object Foo]";
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
321 }
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
322
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
323 sub default {
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
324 my ($self) = @_;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
325
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
326 $self = ref $self || $self;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
327 return $self->_instance ? $self->_instance : $self->_instance($self->new());
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
328 }
163
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
329
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
330 package Bar;
165
76515373dac0 Added Class::Template,
wizard
parents: 164
diff changeset
331 use parent qw(Foo);
163
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
332
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
333 __PACKAGE__->info({language => 'English', version => 2}); # will define own 'info' but will loose original data.
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
334 __PACKAGE__->mappings->{sayHello} = \&SayHello; # will not affect Foo->mappings;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
335
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
336 package main;
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
337
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
338 my $foo = Foo->default; # will be a Foo object
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
339 my $bar = Bar->default; # will be a Bar object
163
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
340
6ce1f052b90a temp commit
wizard
parents: 153
diff changeset
341 =end code
90
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
342
dc1da0389db7 Small improvements in the abstract object class
wizard
parents: 49
diff changeset
343 =cut