Mercurial > pub > Impl
annotate Lib/IMPL/Code/BasePropertyImplementor.pm @ 383:2f16f13b000c
DOM localization
| author | cin |
|---|---|
| date | Thu, 23 Jan 2014 17:26:34 +0400 |
| parents | ced5937ff21a |
| children | 0d63f5273307 |
| rev | line source |
|---|---|
| 277 | 1 package IMPL::Code::BasePropertyImplementor; |
| 2 use strict; | |
| 3 | |
| 4 use IMPL::Const qw(:prop :access); | |
|
381
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
5 use Scalar::Util qw(looks_like_number); |
| 277 | 6 |
| 7 use constant { | |
| 8 CodeNoGetAccessor => 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;', | |
| 9 CodeNoSetAccessor => 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;', | |
|
381
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
10 CodeCustomGetAccessor => '$this->$get(@_);', |
|
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
11 CodeCustomSetAccessor => '$this->$set(@_);', |
| 277 | 12 CodeValidator => '$this->$validator(@_);', |
| 13 CodeOwnerCheck => "die new IMPL::Exception('Set accessor is restricted to the owner',\$name,\$class,scalar caller) unless caller eq \$class;" | |
| 14 }; | |
| 15 | |
| 16 sub CodeSetAccessor { | |
| 17 die new IMPL::Exception("Standard accessors not supported",'Set'); | |
| 18 } | |
| 19 | |
| 20 sub CodeGetAccessor { | |
| 21 die new IMPL::Exception("Standard accessors not supported",'Get'); | |
| 22 } | |
| 23 | |
| 24 sub CodeGetListAccessor { | |
| 25 die new IMPL::Exception("Standard accessors not supported",'GetList'); | |
| 26 } | |
| 27 | |
| 28 sub CodeSetListAccessor { | |
| 29 die new IMPL::Exception("Standard accessors not supported",'SetList'); | |
| 30 } | |
| 31 | |
| 32 sub factoryParams { qw($class $name $set $get $validator) }; | |
| 33 | |
| 34 our %ACCESS_CODE = ( | |
| 35 ACCESS_PUBLIC , "", | |
| 36 ACCESS_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);", | |
| 37 ACCESS_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;" | |
| 38 ); | |
| 39 | |
| 40 sub NormalizeSpecification { | |
| 41 my ($this,$spec) = @_; | |
| 42 | |
| 43 return ref $spec | |
| 44 ? $spec | |
| 45 : { | |
| 46 get => $spec & PROP_GET, | |
| 47 set => $spec & PROP_SET, | |
| 48 isList => $spec & PROP_LIST, | |
| 278 | 49 ownerSet => (($spec & PROP_OWNERSET) == PROP_OWNERSET), |
| 50 direct => $spec & PROP_DIRECT | |
| 277 | 51 }; |
| 52 } | |
| 53 | |
| 54 sub CreateFactoryId { | |
| 55 my ($self, $spec) = @_; | |
| 56 | |
| 57 join( '', | |
| 58 map( | |
| 278 | 59 ($_ |
|
381
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
60 ? ( _isCustom($_) |
| 277 | 61 ? 'x' |
| 278 | 62 : 's') |
| 63 : '_'), | |
| 277 | 64 @$spec{qw(get set)} |
| 65 ), | |
| 278 | 66 $spec->{access} || ACCESS_PUBLIC, |
| 277 | 67 $spec->{validator} ? 'v' : '_', |
| 68 $spec->{isList} ? 'l' : '_', | |
| 69 $spec->{ownerSet} ? 'o' : '_' | |
| 70 ); | |
| 71 } | |
| 72 | |
|
381
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
73 sub _isCustom { |
|
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
74 ref($_[0]) eq 'CODE' || not(ref($_[0]) || looks_like_number($_[0])); |
|
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
75 } |
|
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
76 |
| 277 | 77 sub CreateFactory { |
| 78 my ($self,$spec) = @_; | |
| 79 | |
| 80 return $self->CreateFactoryImpl( | |
| 278 | 81 ($spec->{get} |
|
381
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
82 ? ( _isCustom($spec->{get}) |
| 277 | 83 ? $self->CodeCustomGetAccessor |
| 278 | 84 : ($spec->{isList} |
| 85 ? $self->CodeGetListAccessor | |
| 86 : $self->CodeGetAccessor | |
| 87 ) | |
| 88 ) | |
| 89 : $self->CodeNoGetAccessor | |
| 90 ), | |
| 91 ($spec->{set} | |
|
381
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
92 ? ( _isCustom($spec->{set}) |
| 277 | 93 ? $self->CodeCustomSetAccessor |
| 278 | 94 : ($spec->{isList} |
| 95 ? $self->CodeSetListAccessor | |
| 96 : $self->CodeSetAccessor | |
| 97 ) | |
| 98 ) | |
| 99 : $self->CodeNoSetAccessor | |
| 100 ), | |
| 277 | 101 $ACCESS_CODE{$spec->{access} || ACCESS_PUBLIC} || '', |
| 102 $spec->{validator} ? $self->CodeValidator : '', | |
| 103 $spec->{ownerSet} ? $self->CodeOwnerCheck : '' | |
| 104 ); | |
| 105 } | |
| 106 | |
| 107 sub CreateFactoryImpl { | |
| 108 my ($self,$codeGet,$codeSet,$codeAccessCheck,$codeValidator,$codeOwnerCheck) = @_; | |
| 109 | |
| 110 my $strParams = join(',',$self->factoryParams); | |
| 111 | |
| 112 my $factory = <<FACTORY; | |
| 113 | |
| 114 sub { | |
| 115 my ($strParams) = \@_; | |
|
381
ced5937ff21a
Custom getters/setters support method names in theirs definitions
cin
parents:
278
diff
changeset
|
116 return sub { |
| 277 | 117 my \$this = shift; |
| 118 $codeAccessCheck | |
| 119 if (\@_) { | |
| 120 $codeOwnerCheck | |
| 121 $codeValidator | |
| 122 $codeSet | |
| 123 } else { | |
| 124 $codeGet | |
| 125 } | |
| 126 } | |
| 127 } | |
| 128 FACTORY | |
| 129 | |
| 130 return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") ); | |
| 131 } | |
| 132 | |
| 133 | |
| 134 1; | |
| 135 | |
| 136 __END__ | |
| 137 | |
| 138 =pod | |
| 139 | |
| 140 =head1 NAME | |
| 141 | |
| 142 C<IMPL::Code::BasePropertyImplementor> набор впомогательныйх статических методов | |
| 143 для генерации свойств. | |
| 144 | |
| 145 =cut |