Mercurial > pub > Impl
diff Lib/IMPL/Code/DirectPropertyImplementor.pm @ 278:4ddb27ff4a0b
core refactoring
author | cin |
---|---|
date | Mon, 04 Feb 2013 02:10:37 +0400 |
parents | 6585464c4664 |
children |
line wrap: on
line diff
--- a/Lib/IMPL/Code/DirectPropertyImplementor.pm Fri Feb 01 16:37:59 2013 +0400 +++ b/Lib/IMPL/Code/DirectPropertyImplementor.pm Mon Feb 04 02:10:37 2013 +0400 @@ -1,9 +1,13 @@ package IMPL::Code::DirectPropertyImplementor; use strict; +require IMPL::Object::List; + +use IMPL::lang qw(:hash); use IMPL::require { Exception => 'IMPL::Exception', - ArgException => '-IMPL::InvalidArgumentException' + ArgException => '-IMPL::InvalidArgumentException', + DirectPropertyInfo => 'IMPL::Class::DirectPropertyInfo' }; use parent qw(IMPL::Code::BasePropertyImplementor); @@ -33,20 +37,22 @@ );' }; -sub factoryParams { qw($class $name $set $get $validator $field) }; +sub factoryParams { qw($class $name $get $set $validator $field) }; my %cache; sub Implement { - my ($self, $spec) = @_; + my $self = shift; + + my $spec = {}; + + map hashApply($spec,$self->NormalizeSpecification($_)), @_; my $name = $spec->{name} or ArgException->new(name => "The name of the property is required"); my $class = $spec->{class} or ArgException->new(name => "The onwer class must be specified"); - $spec = $self->NormalizeSpecification($spec); - my $id = $self->CreateFactoryId($spec); my $factory = $cache{$id}; unless($factory) { @@ -54,9 +60,37 @@ $cache{$id} = $factory; } + my $field = join( '_', split(/::/, $class), $name); + my $accessor = $factory->($class, $name, $spec->{get}, $spec->{set}, $spec->{validator}, $field); + my $args = { + getter => $spec->{get} ? $accessor : undef, + setter => $spec->{set} ? $accessor : undef, + ownetSet => $spec->{ownerSet} ? 1 : 0, + isList => $spec->{isList} ? 1 : 0, + name => $spec->{name}, + class => $spec->{class}, + type => $spec->{type}, + access => $spec->{access}, + fieldName => $field, + directAccess => $spec->{direct} + }; + delete @$spec{qw(get set ownerSet isList name class type access field direct)}; + + $args->{attributes} = $spec; + + my $propInfo = DirectPropertyInfo->new($args); + + { + no strict 'refs'; + *{"${class}::$name"} = $accessor; + *{"${class}::$name"} = \$field if $args->{directAccess}; + } + $class->SetMeta($propInfo); + + return $propInfo; } 1; \ No newline at end of file