Mercurial > pub > Impl
diff Lib/IMPL/Class/Property/Base.pm @ 194:4d0e1962161c
Replaced tabs with spaces
IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author | cin |
---|---|
date | Tue, 10 Apr 2012 20:08:29 +0400 |
parents | d1676be8afcc |
children | 6d8092d8ce1b |
line wrap: on
line diff
--- a/Lib/IMPL/Class/Property/Base.pm Tue Apr 10 08:13:22 2012 +0400 +++ b/Lib/IMPL/Class/Property/Base.pm Tue Apr 10 20:08:29 2012 +0400 @@ -18,142 +18,142 @@ my $validator_code = '$this->$validator(@_);'; my %access_code = ( - IMPL::Class::Member::MOD_PUBLIC , "", - IMPL::Class::Member::MOD_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);", - IMPL::Class::Member::MOD_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;" + IMPL::Class::Member::MOD_PUBLIC , "", + IMPL::Class::Member::MOD_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);", + IMPL::Class::Member::MOD_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;" ); my $virtual_call = q( - my $method = $this->can($name); + my $method = $this->can($name); return $this->$method(@_) unless $method == $accessor or caller->isa($class); ); my $owner_check = "die new IMPL::Exception('Set accessor is restricted to the owner',\$name,\$class,scalar caller) unless caller eq \$class;"; sub GenerateAccessors { - my ($self,$param,@params) = @_; - - my %accessors; - - if (not ref $param) { - if ($param & prop_list) { - $accessors{get} = ($param & prop_get) ? $self->GenerateGetList(@params) : undef; - $accessors{set} = ($param & prop_set) ? $self->GenerateSetList(@params) : undef; - } else { - $accessors{get} = ($param & prop_get) ? $self->GenerateGet(@params) : undef; - $accessors{set} = ($param & prop_set) ? $self->GenerateSet(@params) : undef; - } - $accessors{owner} = (($param & owner_set) == owner_set) ? $owner_check : ""; - } elsif (UNIVERSAL::isa($param,'HASH')) { - $accessors{get} = $param->{get} ? $custom_accessor_get : undef; - $accessors{set} = $param->{set} ? $custom_accessor_set : undef; - $accessors{owner} = ""; - } else { - die new IMPL::Exception('The unsupported accessor/mutators supplied',$param); - } - - return \%accessors; + my ($self,$param,@params) = @_; + + my %accessors; + + if (not ref $param) { + if ($param & prop_list) { + $accessors{get} = ($param & prop_get) ? $self->GenerateGetList(@params) : undef; + $accessors{set} = ($param & prop_set) ? $self->GenerateSetList(@params) : undef; + } else { + $accessors{get} = ($param & prop_get) ? $self->GenerateGet(@params) : undef; + $accessors{set} = ($param & prop_set) ? $self->GenerateSet(@params) : undef; + } + $accessors{owner} = (($param & owner_set) == owner_set) ? $owner_check : ""; + } elsif (UNIVERSAL::isa($param,'HASH')) { + $accessors{get} = $param->{get} ? $custom_accessor_get : undef; + $accessors{set} = $param->{set} ? $custom_accessor_set : undef; + $accessors{owner} = ""; + } else { + die new IMPL::Exception('The unsupported accessor/mutators supplied',$param); + } + + return \%accessors; } sub GenerateSet { - die new IMPL::Exception("Standard accessors not supported",'Set'); + die new IMPL::Exception("Standard accessors not supported",'Set'); } - + sub GenerateGet { - die new IMPL::Exception("Standard accessors not supported",'Get'); + die new IMPL::Exception("Standard accessors not supported",'Get'); } sub GenerateGetList { - die new IMPL::Exception("Standard accessors not supported",'GetList'); + die new IMPL::Exception("Standard accessors not supported",'GetList'); } sub GenerateSetList { - my ($self) = @_; - die new IMPL::Exception("Standard accessors not supported",'SetList'); + my ($self) = @_; + die new IMPL::Exception("Standard accessors not supported",'SetList'); } sub Make { - my ($self,$propInfo) = @_; - - my $key = $self->MakeFactoryKey($propInfo); - - my $factoryInfo = $factoryCache{$key}; - - unless ($factoryInfo) { - my $mutators = $self->GenerateAccessors($propInfo->Mutators); - $factoryInfo = { - factory => $self->CreateFactory( - $access_code{ $propInfo->Access }, - $propInfo->Attributes->{validator} ? $validator_code : "", - $mutators->{owner}, - $mutators->{get} || $accessor_get_no, - $mutators->{set} || $accessor_set_no - ), - mutators => $mutators - }; - $factoryCache{$key} = $factoryInfo; - } - - { - no strict 'refs'; - *{ $propInfo->Class.'::'.$propInfo->Name } = $factoryInfo->{factory}->($self->RemapFactoryParams($propInfo)); - } - - my $mutators = $factoryInfo->{mutators}; - - $propInfo->canGet( $mutators->{get} ? 1 : 0 ); - $propInfo->canSet( $mutators->{set} ? 1 : 0 ); - $propInfo->ownerSet( $mutators->{owner} ); - - 1; + my ($self,$propInfo) = @_; + + my $key = $self->MakeFactoryKey($propInfo); + + my $factoryInfo = $factoryCache{$key}; + + unless ($factoryInfo) { + my $mutators = $self->GenerateAccessors($propInfo->Mutators); + $factoryInfo = { + factory => $self->CreateFactory( + $access_code{ $propInfo->Access }, + $propInfo->Attributes->{validator} ? $validator_code : "", + $mutators->{owner}, + $mutators->{get} || $accessor_get_no, + $mutators->{set} || $accessor_set_no + ), + mutators => $mutators + }; + $factoryCache{$key} = $factoryInfo; + } + + { + no strict 'refs'; + *{ $propInfo->Class.'::'.$propInfo->Name } = $factoryInfo->{factory}->($self->RemapFactoryParams($propInfo)); + } + + my $mutators = $factoryInfo->{mutators}; + + $propInfo->canGet( $mutators->{get} ? 1 : 0 ); + $propInfo->canSet( $mutators->{set} ? 1 : 0 ); + $propInfo->ownerSet( $mutators->{owner} ); + + 1; } # extract from property info: class, name, get_accessor, set_accessor, validator sub RemapFactoryParams { - my ($self,$propInfo) = @_; - - my $mutators = $propInfo->Mutators; - my $class = $propInfo->Class; - my $validator = $propInfo->Attributes->{validator}; - - die new IMPL::Exception('Can\'t find the specified validator',$class,$validator) if $validator and ref $validator ne 'CODE' and not $class->can($validator); + my ($self,$propInfo) = @_; + + my $mutators = $propInfo->Mutators; + my $class = $propInfo->Class; + my $validator = $propInfo->Attributes->{validator}; + + 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 ( - $propInfo->get(qw(Class Name)), - (ref $mutators? - ($mutators->{set},$mutators->{get}) - : - (undef,undef) - ), - $validator - ); + return ( + $propInfo->get(qw(Class Name)), + (ref $mutators? + ($mutators->{set},$mutators->{get}) + : + (undef,undef) + ), + $validator + ); } sub MakeFactoryKey { - my ($self,$propInfo) = @_; - - my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator}); - - my $implementor = ref $self || $self; - - return join ('', - $implementor, - $access, - $validator ? 'v' : 'n', - ref $mutators ? - ('c' , $mutators->{get} ? 1 : 0, $mutators->{set} ? 1 : 0) - : - ('s',$mutators) - ); + my ($self,$propInfo) = @_; + + my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator}); + + my $implementor = ref $self || $self; + + return join ('', + $implementor, + $access, + $validator ? 'v' : 'n', + ref $mutators ? + ('c' , $mutators->{get} ? 1 : 0, $mutators->{set} ? 1 : 0) + : + ('s',$mutators) + ); } sub CreateFactory { - my ($self,$codeAccessCheck,$codeValidator,$codeOwnerCheck,$codeGet,$codeSet) = @_; - - my $strParams = join(',',$self->factoryParams); - - my $factory = <<FACTORY; - + my ($self,$codeAccessCheck,$codeValidator,$codeOwnerCheck,$codeGet,$codeSet) = @_; + + my $strParams = join(',',$self->factoryParams); + + my $factory = <<FACTORY; + sub { my ($strParams) = \@_; my \$accessor; @@ -161,17 +161,17 @@ my \$this = shift; $codeAccessCheck if (\@_) { - $codeOwnerCheck - $codeValidator - $codeSet + $codeOwnerCheck + $codeValidator + $codeSet } else { - $codeGet + $codeGet } } } FACTORY - return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") ); + return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") ); } 1;