Mercurial > pub > Impl

comparison Lib/IMPL/Code/DirectPropertyImplementor.pm @ 278:4ddb27ff4a0b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
core refactoring
author cin
date Mon, 04 Feb 2013 02:10:37 +0400
parents 6585464c4664
children
comparison
equal deleted inserted replaced
277:6585464c4664 278:4ddb27ff4a0b
1 package IMPL::Code::DirectPropertyImplementor; 1 package IMPL::Code::DirectPropertyImplementor;
2 use strict; 2 use strict;
3 3
4 require IMPL::Object::List;
5
6 use IMPL::lang qw(:hash);
4 use IMPL::require { 7 use IMPL::require {
5 Exception => 'IMPL::Exception', 8 Exception => 'IMPL::Exception',
6 ArgException => '-IMPL::InvalidArgumentException' 9 ArgException => '-IMPL::InvalidArgumentException',
10 DirectPropertyInfo => 'IMPL::Class::DirectPropertyInfo'
7 }; 11 };
8 12
9 use parent qw(IMPL::Code::BasePropertyImplementor); 13 use parent qw(IMPL::Code::BasePropertyImplementor);
10 14
11 use constant { 15 use constant {
31 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] 35 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_]
32 )) 36 ))
33 );' 37 );'
34 }; 38 };
35 39
36 sub factoryParams { qw($class $name $set $get $validator $field) }; 40 sub factoryParams { qw($class $name $get $set $validator $field) };
37 41
38 my %cache; 42 my %cache;
39 43
40 sub Implement { 44 sub Implement {
41 my ($self, $spec) = @_; 45 my $self = shift;
46
47 my $spec = {};
48
49 map hashApply($spec,$self->NormalizeSpecification($_)), @_;
42 50
43 my $name = $spec->{name} 51 my $name = $spec->{name}
44 or ArgException->new(name => "The name of the property is required"); 52 or ArgException->new(name => "The name of the property is required");
45 my $class = $spec->{class} 53 my $class = $spec->{class}
46 or ArgException->new(name => "The onwer class must be specified"); 54 or ArgException->new(name => "The onwer class must be specified");
47
48 $spec = $self->NormalizeSpecification($spec);
49 55
50 my $id = $self->CreateFactoryId($spec); 56 my $id = $self->CreateFactoryId($spec);
51 my $factory = $cache{$id}; 57 my $factory = $cache{$id};
52 unless($factory) { 58 unless($factory) {
53 $factory = $self->CreateFactory($spec); 59 $factory = $self->CreateFactory($spec);
54 $cache{$id} = $factory; 60 $cache{$id} = $factory;
55 } 61 }
56 62
63 my $field = join( '_', split(/::/, $class), $name);
57 64
65 my $accessor = $factory->($class, $name, $spec->{get}, $spec->{set}, $spec->{validator}, $field);
58 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 };
59 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;
60 } 94 }
61 95
62 1; 96 1;