Mercurial > pub > Impl

comparison lib/IMPL/Code/DirectPropertyImplementor.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
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
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;