Mercurial > pub > Impl
view Lib/IMPL/Code/DirectPropertyImplementor.pm @ 360:39842eedd923
language detection from request
author | sergey |
---|---|
date | Tue, 26 Nov 2013 03:22:44 +0400 |
parents | 4ddb27ff4a0b |
children |
line wrap: on
line source
package IMPL::Code::DirectPropertyImplementor; use strict; require IMPL::Object::List; use IMPL::lang qw(:hash); use IMPL::require { Exception => 'IMPL::Exception', ArgException => '-IMPL::InvalidArgumentException', DirectPropertyInfo => 'IMPL::Class::DirectPropertyInfo' }; use parent qw(IMPL::Code::BasePropertyImplementor); use constant { CodeGetAccessor => 'return ($this->{$field});', CodeSetAccessor => 'return ($this->{$field} = $_[0])', CodeGetListAccessor => 'return( wantarray ? @{ $this->{$field} ? $this->{$field} : ( $this->{$field} = IMPL::Object::List->new() ) } : ( $this->{$field} ? $this->{$field} : ( $this->{$field} = IMPL::Object::List->new() ) ) );', CodeSetListAccessor => 'return( wantarray ? @{ $this->{$field} = IMPL::Object::List->new( (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] )} : ($this->{$field} = IMPL::Object::List->new( (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] )) );' }; sub factoryParams { qw($class $name $get $set $validator $field) }; my %cache; sub Implement { 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"); my $id = $self->CreateFactoryId($spec); my $factory = $cache{$id}; unless($factory) { $factory = $self->CreateFactory($spec); $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;