277
+ − 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,
278
+ − 48 ownerSet => (($spec & PROP_OWNERSET) == PROP_OWNERSET),
+ − 49 direct => $spec & PROP_DIRECT
277
+ − 50 };
+ − 51 }
+ − 52
+ − 53 sub CreateFactoryId {
+ − 54 my ($self, $spec) = @_;
+ − 55
+ − 56 join( '',
+ − 57 map(
278
+ − 58 ($_
+ − 59 ? (ref $_ eq 'CODE'
277
+ − 60 ? 'x'
278
+ − 61 : 's')
+ − 62 : '_'),
277
+ − 63 @$spec{qw(get set)}
+ − 64 ),
278
+ − 65 $spec->{access} || ACCESS_PUBLIC,
277
+ − 66 $spec->{validator} ? 'v' : '_',
+ − 67 $spec->{isList} ? 'l' : '_',
+ − 68 $spec->{ownerSet} ? 'o' : '_'
+ − 69 );
+ − 70 }
+ − 71
+ − 72 sub CreateFactory {
+ − 73 my ($self,$spec) = @_;
+ − 74
+ − 75 return $self->CreateFactoryImpl(
278
+ − 76 ($spec->{get}
+ − 77 ? (ref $spec->{get} eq 'CODE'
277
+ − 78 ? $self->CodeCustomGetAccessor
278
+ − 79 : ($spec->{isList}
+ − 80 ? $self->CodeGetListAccessor
+ − 81 : $self->CodeGetAccessor
+ − 82 )
+ − 83 )
+ − 84 : $self->CodeNoGetAccessor
+ − 85 ),
+ − 86 ($spec->{set}
+ − 87 ? (ref $spec->{set} eq 'CODE'
277
+ − 88 ? $self->CodeCustomSetAccessor
278
+ − 89 : ($spec->{isList}
+ − 90 ? $self->CodeSetListAccessor
+ − 91 : $self->CodeSetAccessor
+ − 92 )
+ − 93 )
+ − 94 : $self->CodeNoSetAccessor
+ − 95 ),
277
+ − 96 $ACCESS_CODE{$spec->{access} || ACCESS_PUBLIC} || '',
+ − 97 $spec->{validator} ? $self->CodeValidator : '',
+ − 98 $spec->{ownerSet} ? $self->CodeOwnerCheck : ''
+ − 99 );
+ − 100 }
+ − 101
+ − 102 sub CreateFactoryImpl {
+ − 103 my ($self,$codeGet,$codeSet,$codeAccessCheck,$codeValidator,$codeOwnerCheck) = @_;
+ − 104
+ − 105 my $strParams = join(',',$self->factoryParams);
+ − 106
+ − 107 my $factory = <<FACTORY;
+ − 108
+ − 109 sub {
+ − 110 my ($strParams) = \@_;
+ − 111 my \$accessor;
+ − 112 \$accessor = sub {
+ − 113 my \$this = shift;
+ − 114 $codeAccessCheck
+ − 115 if (\@_) {
+ − 116 $codeOwnerCheck
+ − 117 $codeValidator
+ − 118 $codeSet
+ − 119 } else {
+ − 120 $codeGet
+ − 121 }
+ − 122 }
+ − 123 }
+ − 124 FACTORY
+ − 125
+ − 126 return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") );
+ − 127 }
+ − 128
+ − 129
+ − 130 1;
+ − 131
+ − 132 __END__
+ − 133
+ − 134 =pod
+ − 135
+ − 136 =head1 NAME
+ − 137
+ − 138 C<IMPL::Code::BasePropertyImplementor> набор впомогательныйх статических методов
+ − 139 для генерации свойств.
+ − 140
+ − 141 =cut