Mercurial > pub > Impl

comparison lib/IMPL/Code/BasePropertyImplementor.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children ee36115f6a34
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::Code::BasePropertyImplementor;
2 use strict;
3
4 use IMPL::Const qw(:prop :access);
5 use Scalar::Util qw(looks_like_number);
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;',
10 CodeCustomGetAccessor => '$this->$get(@_);',
11 CodeCustomSetAccessor => '$this->$set(@_);',
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 $spec if ref($spec);
44
45 if (looks_like_number($spec)) {
46 return {
47 get => $spec & PROP_GET,
48 set => $spec & PROP_SET,
49 isList => $spec & PROP_LIST,
50 ownerSet => (($spec & PROP_OWNERSET) == PROP_OWNERSET),
51 direct => $spec & PROP_DIRECT
52 };
53 } else {
54 return {};
55 }
56 }
57
58 sub CreateFactoryId {
59 my ($self, $spec) = @_;
60
61 join( '',
62 map(
63 ($_
64 ? ( _isCustom($_)
65 ? 'x'
66 : 's')
67 : '_'),
68 @$spec{qw(get set)}
69 ),
70 $spec->{access} || ACCESS_PUBLIC,
71 $spec->{validator} ? 'v' : '_',
72 $spec->{isList} ? 'l' : '_',
73 $spec->{ownerSet} ? 'o' : '_'
74 );
75 }
76
77 sub _isCustom {
78 ref($_[0]) eq 'CODE' || not(ref($_[0]) || looks_like_number($_[0]));
79 }
80
81 sub CreateFactory {
82 my ($self,$spec) = @_;
83
84 return $self->CreateFactoryImpl(
85 ($spec->{get}
86 ? ( _isCustom($spec->{get})
87 ? $self->CodeCustomGetAccessor
88 : ($spec->{isList}
89 ? $self->CodeGetListAccessor
90 : $self->CodeGetAccessor
91 )
92 )
93 : $self->CodeNoGetAccessor
94 ),
95 ($spec->{set}
96 ? ( _isCustom($spec->{set})
97 ? $self->CodeCustomSetAccessor
98 : ($spec->{isList}
99 ? $self->CodeSetListAccessor
100 : $self->CodeSetAccessor
101 )
102 )
103 : $self->CodeNoSetAccessor
104 ),
105 $ACCESS_CODE{$spec->{access} || ACCESS_PUBLIC} || '',
106 $spec->{validator} ? $self->CodeValidator : '',
107 $spec->{ownerSet} ? $self->CodeOwnerCheck : ''
108 );
109 }
110
111 sub CreateFactoryImpl {
112 my ($self,$codeGet,$codeSet,$codeAccessCheck,$codeValidator,$codeOwnerCheck) = @_;
113
114 my $strParams = join(',',$self->factoryParams);
115
116 my $factory = <<FACTORY;
117
118 sub {
119 my ($strParams) = \@_;
120 return sub {
121 my \$this = shift;
122 $codeAccessCheck
123 if (\@_) {
124 $codeOwnerCheck
125 $codeValidator
126 $codeSet
127 } else {
128 $codeGet
129 }
130 }
131 }
132 FACTORY
133
134 return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") );
135 }
136
137
138 1;
139
140 __END__
141
142 =pod
143
144 =head1 NAME
145
146 C<IMPL::Code::BasePropertyImplementor> набор впомогательныйх статических методов
147 для генерации свойств.
148
149 =cut