Mercurial > pub > Impl
annotate Lib/IMPL/Class/Property/Base.pm @ 94:79bf75223afe
Fixed security related bugs
author | wizard |
---|---|
date | Thu, 29 Apr 2010 01:31:27 +0400 |
parents | f017c0d7527c |
children | a07a66fd8d5c |
rev | line source |
---|---|
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
1 package IMPL::Class::Property::Base; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
2 use strict; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
3 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
4 use IMPL::Class::Property; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
5 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
6 require IMPL::Class::Member; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
7 |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
8 sub factoryParams { qw($class $name $set $get $validator) }; |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
9 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
10 my %factoryCache; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
11 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
12 my $accessor_get_no = 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
13 my $accessor_set_no = 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
14 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
15 my $custom_accessor_get = 'unshift @_, $this and goto &$get;'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
16 my $custom_accessor_set = 'unshift @_, $this and goto &$set;'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
17 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
18 my $validator_code = '$this->$validator(@_);'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
19 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
20 my %access_code = ( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
21 IMPL::Class::Member::MOD_PUBLIC , "", |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
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);", |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
23 IMPL::Class::Member::MOD_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;" |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
24 ); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
25 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
26 my $virtual_call = q( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
27 my $method = $this->can($name); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
28 return $this->$method(@_) unless $method == $accessor or caller->isa($class); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
29 ); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
30 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
31 my $owner_check = "die new IMPL::Exception('Set accessor is restricted to the owner',\$name,\$class,scalar caller) unless caller eq \$class;"; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
32 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
33 sub GenerateAccessors { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
34 my ($self,$param,@params) = @_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
35 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
36 my %accessors; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
37 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
38 if (not ref $param) { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
39 if ($param & prop_list) { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
40 $accessors{get} = ($param & prop_get) ? $self->GenerateGetList(@params) : $accessor_get_no; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
41 $accessors{set} = ($param & prop_set) ? $self->GenerateSetList(@params) : $accessor_set_no; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
42 } else { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
43 $accessors{get} = ($param & prop_get) ? $self->GenerateGet(@params) : $accessor_get_no; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
44 $accessors{set} = ($param & prop_set) ? $self->GenerateSet(@params) : $accessor_set_no; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
45 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
46 $accessors{owner} = (($param & owner_set) == owner_set) ? $owner_check : ""; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
47 } elsif (UNIVERSAL::isa($param,'HASH')) { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
48 $accessors{get} = $param->{get} ? $custom_accessor_get : $accessor_get_no; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
49 $accessors{set} = $param->{set} ? $custom_accessor_set : $accessor_set_no; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
50 $accessors{owner} = ""; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
51 } else { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
52 die new IMPL::Exception('The unsupported accessor/mutators supplied',$param); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
53 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
54 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
55 return \%accessors; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
56 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
57 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
58 sub GenerateSet { |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
59 die new IMPL::Exception("Standard accessors not supported",'Set'); |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
60 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
61 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
62 sub GenerateGet { |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
63 die new IMPL::Exception("Standard accessors not supported",'Get'); |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
64 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
65 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
66 sub GenerateGetList { |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
67 die new IMPL::Exception("Standard accessors not supported",'GetList'); |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
68 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
69 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
70 sub GenerateSetList { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
71 my ($self) = @_; |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
72 die new IMPL::Exception("Standard accessors not supported",'SetList'); |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
73 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
74 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
75 sub Make { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
76 my ($self,$propInfo) = @_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
77 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
78 my $key = $self->MakeFactoryKey($propInfo); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
79 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
80 my $factory = $factoryCache{$key}; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
81 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
82 unless ($factory) { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
83 my $mutators = $self->GenerateAccessors($propInfo->Mutators); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
84 $factory = $self->CreateFactory( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
85 $access_code{ $propInfo->Access }, |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
86 $propInfo->Attributes->{validator} ? $validator_code : "", |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
87 $mutators->{owner}, |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
88 $mutators->{get}, |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
89 $mutators->{set} |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
90 ); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
91 $factoryCache{$key} = $factory; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
92 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
93 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
94 { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
95 no strict 'refs'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
96 *{ $propInfo->Class.'::'.$propInfo->Name } = &$factory($self->RemapFactoryParams($propInfo)); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
97 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
98 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
99 my $mutators = $propInfo->Mutators; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
100 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
101 if (ref $mutators) { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
102 $propInfo->canGet( $mutators->{get} ? 1 : 0 ); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
103 $propInfo->canSet( $mutators->{set} ? 1 : 0 ); |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
104 $propInfo->ownerSet(0); |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
105 } else { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
106 $propInfo->canGet( $mutators & prop_get ); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
107 $propInfo->canSet( $mutators & prop_set ); |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
108 $propInfo->ownerSet( ($mutators & owner_set) == owner_set ); |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
109 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
110 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
111 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
112 # extract from property info: class, name, get_accessor, set_accessor, validator |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
113 sub RemapFactoryParams { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
114 my ($self,$propInfo) = @_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
115 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
116 my $mutators = $propInfo->Mutators; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
117 my $class = $propInfo->Class; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
118 my $validator = $propInfo->Attributes->{validator}; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
119 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
120 die new IMPL::Exception('Can\'t find the specified validator',$class,$validator) if $validator and ref $validator ne 'CODE' and not $class->can($validator); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
121 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
122 return ( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
123 $propInfo->get(qw(Class Name)), |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
124 (ref $mutators? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
125 ($mutators->{set},$mutators->{get}) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
126 : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
127 (undef,undef) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
128 ), |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
129 $validator |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
130 ); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
131 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
132 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
133 sub MakeFactoryKey { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
134 my ($self,$propInfo) = @_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
135 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
136 my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator}); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
137 |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
138 my $implementor = ref $self || $self; |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
139 |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
140 return join ('', |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
141 $implementor, |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
142 $access, |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
143 $validator ? 'v' : 'n', |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
144 ref $mutators ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
145 ('c' , $mutators->{get} ? 1 : 0, $mutators->{set} ? 1 : 0) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
146 : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
147 (($mutators & prop_list) ? 'l' : 's' , ($mutators & prop_get) ? 1 : 0, ($mutators & prop_set) ? ((($mutators & owner_set) == owner_set) ? 2 : 1 ) : 0 ) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
148 ); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
149 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
150 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
151 sub CreateFactory { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
152 my ($self,$codeAccessCheck,$codeValidator,$codeOwnerCheck,$codeGet,$codeSet) = @_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
153 |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
154 my $strParams = join(',',$self->factoryParams); |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
155 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
156 my $factory = <<FACTORY; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
157 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
158 sub { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
159 my ($strParams) = \@_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
160 my \$accessor; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
161 \$accessor = sub { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
162 my \$this = shift; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
163 $codeAccessCheck |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
164 if (\@_) { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
165 $codeOwnerCheck |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
60
diff
changeset
|
166 $codeValidator |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
167 $codeSet |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
168 } else { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
169 $codeGet |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
170 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
171 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
172 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
173 FACTORY |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
174 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
175 return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") ); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
176 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
177 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
178 1; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
179 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
180 __END__ |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
181 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
182 =pod |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
183 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
184 =head1 DESCRIPTION |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
185 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
186 Базовый класс для реализации свойств. |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
187 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
188 По существу свойства состоят из двух методов для установки и получения значений. Также |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
189 существует несколько вариантов доступа к свойству, и метод верификации значения. Еще |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
190 свойства могут быть виртуальными. |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
191 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
192 Для создания реализатора свойств достаточно унаследовать от этого класса и описать |
80 | 193 методы для генерации кода получения и установки значения. |
194 | |
195 =head1 MEMBERS | |
196 | |
197 =over | |
198 | |
199 =item C<Make($propertyInfo)> | |
200 | |
201 Создает свойство у класса, на основе C<$propertyInfo>, описывающего свойство. C<IMPL::Class::PropertyInfo>. | |
202 | |
203 =back | |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
204 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
diff
changeset
|
205 =cut |