Mercurial > pub > Impl
diff Lib/IMPL/Class/Property/Direct.pm @ 55:609b59c9f03c
Web application
rewrote prop_list implementation to support IMPL::Object::List
author | wizard |
---|---|
date | Wed, 03 Mar 2010 17:40:18 +0300 |
parents | 15d720913562 |
children | 0f3e369553bd |
line wrap: on
line diff
--- a/Lib/IMPL/Class/Property/Direct.pm Tue Mar 02 20:15:57 2010 +0300 +++ b/Lib/IMPL/Class/Property/Direct.pm Wed Mar 03 17:40:18 2010 +0300 @@ -4,6 +4,7 @@ use base qw(IMPL::Object::Accessor Exporter); our @EXPORT = qw(_direct); +require IMPL::Object::List; use IMPL::Class::Property; require IMPL::Exception; @@ -22,17 +23,35 @@ my $accessor_set_no = 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;'; my $accessor_set = 'return( $this->{$field} = @_ == 1 ? $_[0] : [@_] );'; my $accessor_get = 'return( $this->{$field} );'; -my $list_accessor_set = 'return( @{ ($this->{$field} = IMPL::Object::List->new( ( (@_ == 1 and ref $_[0] eq \'ARRAY\') ? $_[0] : [@_] ) || [] ) } );'; -my $list_accessor_get = 'return( @{ $this->{$field} ? $this->{$field} : $this->{$field} = IMPL::Object::List->new() } );'; +my $list_accessor_set = '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] : [@_] + )) +);'; +my $list_accessor_get = 'return( + wantarray ? + @{ $this->{$field} ? + $this->{$field} : + ( $this->{$field} = IMPL::Object::List->new() ) + } : + ( $this->{$field} ? + $this->{$field} : + ( $this->{$field} = IMPL::Object::List->new() ) + ) +);'; my $custom_accessor_get = 'unshift @_, $this and goto &$get;'; my $custom_accessor_set = 'unshift @_, $this and goto &$set;'; my %accessor_cache; sub mk_acessor { - my ($virtual,$access,$class,$name,$mutators,$field) = @_; + my ($virtual,$access,$class,$name,$mutators,$field,$validator) = @_; my ($get,$set) = ref $mutators ? ( $mutators->{get}, $mutators->{set}) : ($mutators & prop_get, $mutators & prop_set); - my $key = join '',$virtual,$access,$get ? 1 : 0,$set ? 1 : 0, (ref $mutators ? 'c' : ($mutators & prop_list() ? 'l' : 's')); + my $key = join '',$virtual,$access,$get ? 1 : 0,$set ? 1 : 0, (ref $mutators ? 'c' : ($mutators & prop_list() ? 'l' : 's')), $validator ? 1 : 0 ; my $factory = $accessor_cache{$key}; if (not $factory) { my $code = @@ -47,8 +66,10 @@ my \$method = \$this->can(\$name); return \$this->\$method(\@_) unless \$method == \$accessor or caller->isa(\$class); VCALL - $code .= "$access_private\n" if $access == IMPL::Class::Member::MOD_PRIVATE; - $code .= "$access_protected\n" if $access == IMPL::Class::Member::MOD_PROTECTED; + $code .= ' 'x8 . "$access_private\n" if $access == IMPL::Class::Member::MOD_PRIVATE; + $code .= ' 'x8 . "$access_protected\n" if $access == IMPL::Class::Member::MOD_PROTECTED; + $code .= ' 'x8 . '$this->$validator(@_);'."\n" if $validator; + my ($codeGet,$codeSet); if (ref $mutators) { $codeGet = $get ? $custom_accessor_get : $accessor_get_no; @@ -72,23 +93,31 @@ } } END - $factory = eval $code or die new IMPL::Exception('Failed to generate the accessor',$@); + warn $code; + $factory = eval $code; + if (not $factory) { + my $err = $@; + die new IMPL::Exception('Failed to generate the accessor factory',$err); + } $accessor_cache{$key} = $factory; } - return $factory->($class,$name,$set,$get, $field); + + die new IMPL::Exception('Can\'t find the specified validator',$class,$validator) if $validator and ref $validator ne 'CODE' and not $class->can($validator); + + return $factory->($class,$name,$set,$get, $field, $validator); } sub Make { my ($self,$propInfo) = @_; my $isExportField = ref $self ? ($self->ExportField || 0) : 0; - my ($class,$name,$virt,$access,$mutators) = $propInfo->get qw(Class Name Virtual Access Mutators); + my ($class,$name,$virt,$access,$mutators,$attr) = $propInfo->get qw(Class Name Virtual Access Mutators Attributes); (my $field = "${class}_$name") =~ s/::/_/g; my $propGlob = $class.'::'.$name; no strict 'refs'; - *$propGlob = mk_acessor($virt,$access,$class,$name,$mutators,$field); + *$propGlob = mk_acessor($virt,$access,$class,$name,$mutators,$field,$attr->{validator}); *$propGlob = \$field if $isExportField; if (ref $mutators) {