Mercurial > pub > Impl

comparison Lib/IMPL/Class/Property/Base.pm @ 59:0f3e369553bd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents
children b0c068da93ac
comparison
equal deleted inserted replaced
58:a35b60b16a99 59:0f3e369553bd
1 package IMPL::Class::Property::Base;
2 use strict;
3
4 use IMPL::Class::Property;
5
6 require IMPL::Class::Member;
7
8 our @factoryParams = qw($class $name $set $get $validator);
9
10 my %factoryCache;
11
12 my $accessor_get_no = 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;';
13 my $accessor_set_no = 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;';
14
15 my $custom_accessor_get = 'unshift @_, $this and goto &$get;';
16 my $custom_accessor_set = 'unshift @_, $this and goto &$set;';
17
18 my $validator_code = '$this->$validator(@_);';
19
20 my %access_code = (
21 IMPL::Class::Member::MOD_PUBLIC , "",
22 IMPL::Class::Member::MOD_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);",
23 IMPL::Class::Member::MOD_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;"
24 );
25
26 my $virtual_call = q(
27 my $method = $this->can($name);
28 return $this->$method(@_) unless $method == $accessor or caller->isa($class);
29 );
30
31 my $owner_check = "die new IMPL::Exception('Set accessor is restricted to the owner',\$name,\$class,scalar caller) unless caller eq \$class;";
32
33 sub GenerateAccessors {
34 my ($self,$param,@params) = @_;
35
36 my %accessors;
37
38 if (not ref $param) {
39 if ($param & prop_list) {
40 $accessors{get} = ($param & prop_get) ? $self->GenerateGetList(@params) : $accessor_get_no;
41 $accessors{set} = ($param & prop_set) ? $self->GenerateSetList(@params) : $accessor_set_no;
42 } else {
43 $accessors{get} = ($param & prop_get) ? $self->GenerateGet(@params) : $accessor_get_no;
44 $accessors{set} = ($param & prop_set) ? $self->GenerateSet(@params) : $accessor_set_no;
45 }
46 $accessors{owner} = (($param & owner_set) == owner_set) ? $owner_check : "";
47 } elsif (UNIVERSAL::isa($param,'HASH')) {
48 $accessors{get} = $param->{get} ? $custom_accessor_get : $accessor_get_no;
49 $accessors{set} = $param->{set} ? $custom_accessor_set : $accessor_set_no;
50 $accessors{owner} = "";
51 } else {
52 die new IMPL::Exception('The unsupported accessor/mutators supplied',$param);
53 }
54
55 return \%accessors;
56 }
57
58 sub GenerateSet {
59 die new IMPL::Exception("Standard accessors not supported");
60 }
61
62 sub GenerateGet {
63 die new IMPL::Exception("Standard accessors not supported");
64 }
65
66 sub GenerateGetList {
67 die new IMPL::Exception("Standard accessors not supported");
68 }
69
70 sub GenerateSetList {
71 my ($self) = @_;
72 die new IMPL::Exception("Standard accessors not supported");
73 }
74
75 sub Make {
76 my ($self,$propInfo) = @_;
77
78 my $key = $self->MakeFactoryKey($propInfo);
79
80 my $factory = $factoryCache{$key};
81
82 unless ($factory) {
83 my $mutators = $self->GenerateAccessors($propInfo->Mutators);
84 $factory = $self->CreateFactory(
85 $access_code{ $propInfo->Access },
86 $propInfo->Attributes->{validator} ? $validator_code : "",
87 $mutators->{owner},
88 $mutators->{get},
89 $mutators->{set}
90 );
91 $factoryCache{$key} = $factory;
92 }
93
94 {
95 no strict 'refs';
96 *{ $propInfo->Class.'::'.$propInfo->Name } = &$factory($self->RemapFactoryParams($propInfo));
97 }
98
99 my $mutators = $propInfo->Mutators;
100
101 if (ref $mutators) {
102 $propInfo->canGet( $mutators->{get} ? 1 : 0 );
103 $propInfo->canSet( $mutators->{set} ? 1 : 0 );
104 } else {
105 $propInfo->canGet( $mutators & prop_get );
106 $propInfo->canSet( $mutators & prop_set );
107 }
108 }
109
110 # extract from property info: class, name, get_accessor, set_accessor, validator
111 sub RemapFactoryParams {
112 my ($self,$propInfo) = @_;
113
114 my $mutators = $propInfo->Mutators;
115 my $class = $propInfo->Class;
116 my $validator = $propInfo->Attributes->{validator};
117
118 die new IMPL::Exception('Can\'t find the specified validator',$class,$validator) if $validator and ref $validator ne 'CODE' and not $class->can($validator);
119
120 return (
121 $propInfo->get(qw(Class Name)),
122 (ref $mutators?
123 ($mutators->{set},$mutators->{get})
124 :
125 (undef,undef)
126 ),
127 $validator
128 );
129 }
130
131 sub MakeFactoryKey {
132 my ($self,$propInfo) = @_;
133
134 my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator});
135
136 return join ('',
137 $access,
138 $validator ? 'v' : 'n',
139 ref $mutators ?
140 ('c' , $mutators->{get} ? 1 : 0, $mutators->{set} ? 1 : 0)
141 :
142 (($mutators & prop_list) ? 'l' : 's' , ($mutators & prop_get) ? 1 : 0, ($mutators & prop_set) ? ((($mutators & owner_set) == owner_set) ? 2 : 1 ) : 0 )
143 );
144 }
145
146 sub CreateFactory {
147 my ($self,$codeAccessCheck,$codeValidator,$codeOwnerCheck,$codeGet,$codeSet) = @_;
148
149 my $strParams = join(',',@factoryParams);
150
151 my $factory = <<FACTORY;
152
153 sub {
154 my ($strParams) = \@_;
155 my \$accessor;
156 \$accessor = sub {
157 my \$this = shift;
158 $codeAccessCheck
159 $codeValidator
160 if (\@_) {
161 $codeOwnerCheck
162 $codeSet
163 } else {
164 $codeGet
165 }
166 }
167 }
168 FACTORY
169
170 return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") );
171 }
172
173 1;
174
175 __END__
176
177 =pod
178
179 =head1 DESCRIPTION
180
181 Базовый класс для реализации свойств.
182
183 По существу свойства состоят из двух методов для установки и получения значений. Также
184 существует несколько вариантов доступа к свойству, и метод верификации значения. Еще
185 свойства могут быть виртуальными.
186
187 Для создания реализатора свойств достаточно унаследовать от этого класса и описать
188 методы для генерации кода получения и установки значения.
189
190 =cut