Mercurial > pub > Impl

comparison Lib/IMPL/Class/Property/Base.pm @ 230:6d8092d8ce1b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*reworked IMPL::Security *reworked IMPL::Web::Security *refactoring
author sergey
date Mon, 08 Oct 2012 03:37:37 +0400
parents 4d0e1962161c
children 6253872024a4
comparison
equal deleted inserted replaced
229:47f77e6409f7 230:6d8092d8ce1b
1 package IMPL::Class::Property::Base; 1 package IMPL::Class::Property::Base;
2 use strict; 2 use strict;
3 3
4 use IMPL::Class::Property; 4 use IMPL::Const qw(:all);
5
6 require IMPL::Class::Member;
7 5
8 sub factoryParams { qw($class $name $set $get $validator) }; 6 sub factoryParams { qw($class $name $set $get $validator) };
9 7
10 my %factoryCache; 8 my %factoryCache;
11 9
16 my $custom_accessor_set = 'unshift @_, $this and goto &$set;'; 14 my $custom_accessor_set = 'unshift @_, $this and goto &$set;';
17 15
18 my $validator_code = '$this->$validator(@_);'; 16 my $validator_code = '$this->$validator(@_);';
19 17
20 my %access_code = ( 18 my %access_code = (
21 IMPL::Class::Member::MOD_PUBLIC , "", 19 ACCESS_PUBLIC , "",
22 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);", 20 ACCESS_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);",
23 IMPL::Class::Member::MOD_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;" 21 ACCESS_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;"
24 ); 22 );
25 23
26 my $virtual_call = q( 24 my $virtual_call = q(
27 my $method = $this->can($name); 25 my $method = $this->can($name);
28 return $this->$method(@_) unless $method == $accessor or caller->isa($class); 26 return $this->$method(@_) unless $method == $accessor or caller->isa($class);
34 my ($self,$param,@params) = @_; 32 my ($self,$param,@params) = @_;
35 33
36 my %accessors; 34 my %accessors;
37 35
38 if (not ref $param) { 36 if (not ref $param) {
39 if ($param & prop_list) { 37 if ($param & PROP_LIST) {
40 $accessors{get} = ($param & prop_get) ? $self->GenerateGetList(@params) : undef; 38 $accessors{get} = ($param & PROP_GET) ? $self->GenerateGetList(@params) : undef;
41 $accessors{set} = ($param & prop_set) ? $self->GenerateSetList(@params) : undef; 39 $accessors{set} = ($param & PROP_SET) ? $self->GenerateSetList(@params) : undef;
42 } else { 40 } else {
43 $accessors{get} = ($param & prop_get) ? $self->GenerateGet(@params) : undef; 41 $accessors{get} = ($param & PROP_GET) ? $self->GenerateGet(@params) : undef;
44 $accessors{set} = ($param & prop_set) ? $self->GenerateSet(@params) : undef; 42 $accessors{set} = ($param & PROP_SET) ? $self->GenerateSet(@params) : undef;
45 } 43 }
46 $accessors{owner} = (($param & owner_set) == owner_set) ? $owner_check : ""; 44 $accessors{owner} = (($param & PROP_OWNERSET) == PROP_OWNERSET) ? $owner_check : "";
47 } elsif (UNIVERSAL::isa($param,'HASH')) { 45 } elsif (UNIVERSAL::isa($param,'HASH')) {
48 $accessors{get} = $param->{get} ? $custom_accessor_get : undef; 46 $accessors{get} = $param->{get} ? $custom_accessor_get : undef;
49 $accessors{set} = $param->{set} ? $custom_accessor_set : undef; 47 $accessors{set} = $param->{set} ? $custom_accessor_set : undef;
50 $accessors{owner} = ""; 48 $accessors{owner} = "";
51 } else { 49 } else {
106 $propInfo->ownerSet( $mutators->{owner} ); 104 $propInfo->ownerSet( $mutators->{owner} );
107 105
108 1; 106 1;
109 } 107 }
110 108
109 sub Implement {
110 my ($self,$spec) = @_;
111 }
112
111 # extract from property info: class, name, get_accessor, set_accessor, validator 113 # extract from property info: class, name, get_accessor, set_accessor, validator
112 sub RemapFactoryParams { 114 sub RemapFactoryParams {
113 my ($self,$propInfo) = @_; 115 my ($self,$propInfo) = @_;
114 116
115 my $mutators = $propInfo->Mutators; 117 my $mutators = $propInfo->Mutators;