Mercurial > pub > Impl

comparison Lib/IMPL/Code/BasePropertyImplementor.pm @ 277:6585464c4664

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync (unstable)
author sergey
date Fri, 01 Feb 2013 16:37:59 +0400
parents
children 4ddb27ff4a0b
comparison
equal deleted inserted replaced
276:8a5da17d7ef9 277:6585464c4664
1 package IMPL::Code::BasePropertyImplementor;
2 use strict;
3
4 use IMPL::Const qw(:prop :access);
5
6 use constant {
7 CodeNoGetAccessor => 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;',
8 CodeNoSetAccessor => 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;',
9 CodeCustomGetAccessor => 'unshift @_, $this and goto &$get;',
10 CodeCustomSetAccessor => 'unshift @_, $this and goto &$set;',
11 CodeValidator => '$this->$validator(@_);',
12 CodeOwnerCheck => "die new IMPL::Exception('Set accessor is restricted to the owner',\$name,\$class,scalar caller) unless caller eq \$class;"
13 };
14
15 sub CodeSetAccessor {
16 die new IMPL::Exception("Standard accessors not supported",'Set');
17 }
18
19 sub CodeGetAccessor {
20 die new IMPL::Exception("Standard accessors not supported",'Get');
21 }
22
23 sub CodeGetListAccessor {
24 die new IMPL::Exception("Standard accessors not supported",'GetList');
25 }
26
27 sub CodeSetListAccessor {
28 die new IMPL::Exception("Standard accessors not supported",'SetList');
29 }
30
31 sub factoryParams { qw($class $name $set $get $validator) };
32
33 our %ACCESS_CODE = (
34 ACCESS_PUBLIC , "",
35 ACCESS_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);",
36 ACCESS_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;"
37 );
38
39 sub NormalizeSpecification {
40 my ($this,$spec) = @_;
41
42 return ref $spec
43 ? $spec
44 : {
45 get => $spec & PROP_GET,
46 set => $spec & PROP_SET,
47 isList => $spec & PROP_LIST,
48 ownerSet => $spec & PROP_OWNERSET
49 };
50 }
51
52 sub CreateFactoryId {
53 my ($self, $spec) = @_;
54
55 join( '',
56 map(
57 $_
58 ? ref $_ eq 'CODE'
59 ? 'x'
60 : 's'
61 : '_',
62 @$spec{qw(get set)}
63 ),
64 $spec->{access},
65 $spec->{validator} ? 'v' : '_',
66 $spec->{isList} ? 'l' : '_',
67 $spec->{ownerSet} ? 'o' : '_'
68 );
69 }
70
71 sub CreateFactory {
72 my ($self,$spec) = @_;
73
74 return $self->CreateFactoryImpl(
75 $spec->{get}
76 ? ref $spec->{get} eq 'CODE'
77 ? $self->CodeCustomGetAccessor
78 : $spec->{isList}
79 ? $spec->CodeGetListAccessor
80 : $spec->CodeGetAccessor
81 : $spec->CodeNoGetAccessor,
82 $spec->{set}
83 ? ref $spec->{set} eq 'CODE'
84 ? $self->CodeCustomSetAccessor
85 : $spec->{isList}
86 ? $spec->CodeSetListAccessor
87 : $spec->CodeSetAccessor
88 : $spec->CodeNoSetAccessor,
89 $ACCESS_CODE{$spec->{access} || ACCESS_PUBLIC} || '',
90 $spec->{validator} ? $self->CodeValidator : '',
91 $spec->{ownerSet} ? $self->CodeOwnerCheck : ''
92 );
93 }
94
95 sub CreateFactoryImpl {
96 my ($self,$codeGet,$codeSet,$codeAccessCheck,$codeValidator,$codeOwnerCheck) = @_;
97
98 my $strParams = join(',',$self->factoryParams);
99
100 my $factory = <<FACTORY;
101
102 sub {
103 my ($strParams) = \@_;
104 my \$accessor;
105 \$accessor = sub {
106 my \$this = shift;
107 $codeAccessCheck
108 if (\@_) {
109 $codeOwnerCheck
110 $codeValidator
111 $codeSet
112 } else {
113 $codeGet
114 }
115 }
116 }
117 FACTORY
118
119 return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") );
120 }
121
122
123 1;
124
125 __END__
126
127 =pod
128
129 =head1 NAME
130
131 C<IMPL::Code::BasePropertyImplementor> набор впомогательныйх статических методов
132 для генерации свойств.
133
134 =cut