Mercurial > pub > Impl
view Lib/IMPL/Code/AccessorPropertyImplementor.pm @ 361:eff7f75a4408
added cookie support for the request language detection
author | cin |
---|---|
date | Wed, 27 Nov 2013 17:12:38 +0400 |
parents | 4ddb27ff4a0b |
children |
line wrap: on
line source
package IMPL::Code::AccessorPropertyImplementor; use strict; use IMPL::lang qw(:hash); use IMPL::require { Exception => '-IMPL::Exception', ArgException => '-IMPL::InvalidArgumentException', AccessorPropertyInfo => '-IMPL::Class::AccessorPropertyInfo' }; require IMPL::Class::AccessorPropertyInfo; require IMPL::Object::List; use parent qw(IMPL::Code::BasePropertyImplementor); use constant { CodeGetAccessor => 'return $this->get($field);', CodeSetAccessor => 'return $this->set($field,@_);', CodeSetListAccessor => 'my $val = IMPL::Object::List->new( (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] ); $this->set($field,$val); return( wantarray ? @{ $val } : $val );', CodeGetListAccessor => 'my $val = $this->get($field); $this->set($field,$val = IMPL::Object::List->new()) unless $val; return( wantarray ? @{ $val } : $val );' }; 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 = $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 }; delete @$spec{qw(get set ownerSet isList name class type access field direct)}; $args->{attributes} = $spec; my $propInfo = AccessorPropertyInfo->new($args); { no strict 'refs'; *{"${class}::$name"} = $accessor; } $class->SetMeta($propInfo); return $propInfo; } 1;