annotate lib/IMPL/Code/BasePropertyImplementor.pm @ 411:ee36115f6a34 ref20150831

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