|
407
|
1 package IMPL::Code::DirectPropertyImplementor;
|
|
|
2 use strict;
|
|
|
3
|
|
|
4 require IMPL::Object::List;
|
|
|
5
|
|
|
6 use IMPL::lang qw(:hash);
|
|
|
7 use IMPL::require {
|
|
|
8 Exception => 'IMPL::Exception',
|
|
|
9 ArgException => '-IMPL::InvalidArgumentException',
|
|
|
10 DirectPropertyInfo => 'IMPL::Class::DirectPropertyInfo'
|
|
|
11 };
|
|
|
12
|
|
|
13 use parent qw(IMPL::Code::BasePropertyImplementor);
|
|
|
14
|
|
|
15 use constant {
|
|
|
16 CodeGetAccessor => 'return ($this->{$field});',
|
|
|
17 CodeSetAccessor => 'return ($this->{$field} = $_[0])',
|
|
|
18 CodeGetListAccessor => 'return(
|
|
|
19 wantarray ?
|
|
|
20 @{ $this->{$field} ?
|
|
|
21 $this->{$field} :
|
|
|
22 ( $this->{$field} = IMPL::Object::List->new() )
|
|
|
23 } :
|
|
|
24 ( $this->{$field} ?
|
|
|
25 $this->{$field} :
|
|
|
26 ( $this->{$field} = IMPL::Object::List->new() )
|
|
|
27 )
|
|
|
28 );',
|
|
|
29 CodeSetListAccessor => 'return(
|
|
|
30 wantarray ?
|
|
|
31 @{ $this->{$field} = IMPL::Object::List->new(
|
|
|
32 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_]
|
|
|
33 )} :
|
|
|
34 ($this->{$field} = IMPL::Object::List->new(
|
|
|
35 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_]
|
|
|
36 ))
|
|
|
37 );'
|
|
|
38 };
|
|
|
39
|
|
|
40 sub factoryParams { qw($class $name $get $set $validator $field) };
|
|
|
41
|
|
|
42 my %cache;
|
|
|
43
|
|
|
44 sub Implement {
|
|
|
45 my $self = shift;
|
|
|
46
|
|
|
47 my $spec = {};
|
|
|
48
|
|
|
49 map hashApply($spec,$self->NormalizeSpecification($_)), @_;
|
|
|
50
|
|
|
51 my $name = $spec->{name}
|
|
|
52 or ArgException->new(name => "The name of the property is required");
|
|
|
53 my $class = $spec->{class}
|
|
|
54 or ArgException->new(name => "The onwer class must be specified");
|
|
|
55
|
|
|
56 my $id = $self->CreateFactoryId($spec);
|
|
|
57 my $factory = $cache{$id};
|
|
|
58 unless($factory) {
|
|
|
59 $factory = $self->CreateFactory($spec);
|
|
|
60 $cache{$id} = $factory;
|
|
|
61 }
|
|
|
62
|
|
|
63 my $field = join( '_', split(/::/, $class), $name);
|
|
|
64
|
|
|
65 my $accessor = $factory->($class, $name, $spec->{get}, $spec->{set}, $spec->{validator}, $field);
|
|
|
66
|
|
|
67 my $args = {
|
|
|
68 getter => $spec->{get} ? $accessor : undef,
|
|
|
69 setter => $spec->{set} ? $accessor : undef,
|
|
|
70 ownetSet => $spec->{ownerSet} ? 1 : 0,
|
|
|
71 isList => $spec->{isList} ? 1 : 0,
|
|
|
72 name => $spec->{name},
|
|
|
73 class => $spec->{class},
|
|
|
74 type => $spec->{type},
|
|
|
75 access => $spec->{access},
|
|
|
76 fieldName => $field,
|
|
|
77 directAccess => $spec->{direct}
|
|
|
78 };
|
|
|
79
|
|
|
80 delete @$spec{qw(get set ownerSet isList name class type access field direct)};
|
|
|
81
|
|
|
82 $args->{attributes} = $spec;
|
|
|
83
|
|
|
84 my $propInfo = DirectPropertyInfo->new($args);
|
|
|
85
|
|
|
86 {
|
|
|
87 no strict 'refs';
|
|
|
88 *{"${class}::$name"} = $accessor;
|
|
|
89 *{"${class}::$name"} = \$field if $args->{directAccess};
|
|
|
90 }
|
|
|
91 $class->SetMeta($propInfo);
|
|
|
92
|
|
|
93 return $propInfo;
|
|
|
94 }
|
|
|
95
|
|
|
96 1; |
