Mercurial > pub > Impl

comparison Lib/IMPL/Class/Property/Base.pm @ 60:b0c068da93ac

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Lazy activation for the configuration objects (final concept) small fixes
author wizard
date Tue, 09 Mar 2010 19:47:39 +0300
parents 0f3e369553bd
children 76b878ad6596
comparison
equal deleted inserted replaced
59:0f3e369553bd 60:b0c068da93ac
3 3
4 use IMPL::Class::Property; 4 use IMPL::Class::Property;
5 5
6 require IMPL::Class::Member; 6 require IMPL::Class::Member;
7 7
8 our @factoryParams = qw($class $name $set $get $validator); 8 sub factoryParams { qw($class $name $set $get $validator) };
9 9
10 my %factoryCache; 10 my %factoryCache;
11 11
12 my $accessor_get_no = 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;'; 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;'; 13 my $accessor_set_no = 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;';
54 54
55 return \%accessors; 55 return \%accessors;
56 } 56 }
57 57
58 sub GenerateSet { 58 sub GenerateSet {
59 die new IMPL::Exception("Standard accessors not supported"); 59 die new IMPL::Exception("Standard accessors not supported",'Set');
60 } 60 }
61 61
62 sub GenerateGet { 62 sub GenerateGet {
63 die new IMPL::Exception("Standard accessors not supported"); 63 die new IMPL::Exception("Standard accessors not supported",'Get');
64 } 64 }
65 65
66 sub GenerateGetList { 66 sub GenerateGetList {
67 die new IMPL::Exception("Standard accessors not supported"); 67 die new IMPL::Exception("Standard accessors not supported",'GetList');
68 } 68 }
69 69
70 sub GenerateSetList { 70 sub GenerateSetList {
71 my ($self) = @_; 71 my ($self) = @_;
72 die new IMPL::Exception("Standard accessors not supported"); 72 die new IMPL::Exception("Standard accessors not supported",'SetList');
73 } 73 }
74 74
75 sub Make { 75 sub Make {
76 my ($self,$propInfo) = @_; 76 my ($self,$propInfo) = @_;
77 77
99 my $mutators = $propInfo->Mutators; 99 my $mutators = $propInfo->Mutators;
100 100
101 if (ref $mutators) { 101 if (ref $mutators) {
102 $propInfo->canGet( $mutators->{get} ? 1 : 0 ); 102 $propInfo->canGet( $mutators->{get} ? 1 : 0 );
103 $propInfo->canSet( $mutators->{set} ? 1 : 0 ); 103 $propInfo->canSet( $mutators->{set} ? 1 : 0 );
104 $propInfo->ownerSet(0);
104 } else { 105 } else {
105 $propInfo->canGet( $mutators & prop_get ); 106 $propInfo->canGet( $mutators & prop_get );
106 $propInfo->canSet( $mutators & prop_set ); 107 $propInfo->canSet( $mutators & prop_set );
108 $propInfo->ownerSet( ($mutators & owner_set) == owner_set );
107 } 109 }
108 } 110 }
109 111
110 # extract from property info: class, name, get_accessor, set_accessor, validator 112 # extract from property info: class, name, get_accessor, set_accessor, validator
111 sub RemapFactoryParams { 113 sub RemapFactoryParams {
131 sub MakeFactoryKey { 133 sub MakeFactoryKey {
132 my ($self,$propInfo) = @_; 134 my ($self,$propInfo) = @_;
133 135
134 my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator}); 136 my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator});
135 137
138 my $implementor = ref $self || $self;
139
136 return join ('', 140 return join ('',
141 $implementor,
137 $access, 142 $access,
138 $validator ? 'v' : 'n', 143 $validator ? 'v' : 'n',
139 ref $mutators ? 144 ref $mutators ?
140 ('c' , $mutators->{get} ? 1 : 0, $mutators->{set} ? 1 : 0) 145 ('c' , $mutators->{get} ? 1 : 0, $mutators->{set} ? 1 : 0)
141 : 146 :
144 } 149 }
145 150
146 sub CreateFactory { 151 sub CreateFactory {
147 my ($self,$codeAccessCheck,$codeValidator,$codeOwnerCheck,$codeGet,$codeSet) = @_; 152 my ($self,$codeAccessCheck,$codeValidator,$codeOwnerCheck,$codeGet,$codeSet) = @_;
148 153
149 my $strParams = join(',',@factoryParams); 154 my $strParams = join(',',$self->factoryParams);
150 155
151 my $factory = <<FACTORY; 156 my $factory = <<FACTORY;
152 157
153 sub { 158 sub {
154 my ($strParams) = \@_; 159 my ($strParams) = \@_;