comparison Lib/IMPL/Class/Property/Base.pm @ 133:a07a66fd8d5c

Added IMPL::Class::MethodInfo IMPL::Class::Property::Base optimizations
author wizard
date Fri, 18 Jun 2010 16:27:28 +0400
parents f017c0d7527c
children 44977efed303
comparison
equal deleted inserted replaced
132:42fbb38d4a48 133:a07a66fd8d5c
35 35
36 my %accessors; 36 my %accessors;
37 37
38 if (not ref $param) { 38 if (not ref $param) {
39 if ($param & prop_list) { 39 if ($param & prop_list) {
40 $accessors{get} = ($param & prop_get) ? $self->GenerateGetList(@params) : $accessor_get_no; 40 $accessors{get} = ($param & prop_get) ? $self->GenerateGetList(@params) : undef;
41 $accessors{set} = ($param & prop_set) ? $self->GenerateSetList(@params) : $accessor_set_no; 41 $accessors{set} = ($param & prop_set) ? $self->GenerateSetList(@params) : undef;
42 } else { 42 } else {
43 $accessors{get} = ($param & prop_get) ? $self->GenerateGet(@params) : $accessor_get_no; 43 $accessors{get} = ($param & prop_get) ? $self->GenerateGet(@params) : undef;
44 $accessors{set} = ($param & prop_set) ? $self->GenerateSet(@params) : $accessor_set_no; 44 $accessors{set} = ($param & prop_set) ? $self->GenerateSet(@params) : undef;
45 } 45 }
46 $accessors{owner} = (($param & owner_set) == owner_set) ? $owner_check : ""; 46 $accessors{owner} = (($param & owner_set) == owner_set) ? $owner_check : "";
47 } elsif (UNIVERSAL::isa($param,'HASH')) { 47 } elsif (UNIVERSAL::isa($param,'HASH')) {
48 $accessors{get} = $param->{get} ? $custom_accessor_get : $accessor_get_no; 48 $accessors{get} = $param->{get} ? $custom_accessor_get : undef;
49 $accessors{set} = $param->{set} ? $custom_accessor_set : $accessor_set_no; 49 $accessors{set} = $param->{set} ? $custom_accessor_set : undef;
50 $accessors{owner} = ""; 50 $accessors{owner} = "";
51 } else { 51 } else {
52 die new IMPL::Exception('The unsupported accessor/mutators supplied',$param); 52 die new IMPL::Exception('The unsupported accessor/mutators supplied',$param);
53 } 53 }
54 54
75 sub Make { 75 sub Make {
76 my ($self,$propInfo) = @_; 76 my ($self,$propInfo) = @_;
77 77
78 my $key = $self->MakeFactoryKey($propInfo); 78 my $key = $self->MakeFactoryKey($propInfo);
79 79
80 my $factory = $factoryCache{$key}; 80 my $factoryInfo = $factoryCache{$key};
81 81
82 unless ($factory) { 82 unless ($factoryInfo) {
83 my $mutators = $self->GenerateAccessors($propInfo->Mutators); 83 my $mutators = $self->GenerateAccessors($propInfo->Mutators);
84 $factory = $self->CreateFactory( 84 $factoryInfo = {
85 $access_code{ $propInfo->Access }, 85 factory => $self->CreateFactory(
86 $propInfo->Attributes->{validator} ? $validator_code : "", 86 $access_code{ $propInfo->Access },
87 $mutators->{owner}, 87 $propInfo->Attributes->{validator} ? $validator_code : "",
88 $mutators->{get}, 88 $mutators->{owner},
89 $mutators->{set} 89 $mutators->{get} || $accessor_get_no,
90 ); 90 $mutators->{set} || $accessor_set_no
91 $factoryCache{$key} = $factory; 91 ),
92 mutators => $mutators
93 };
94 $factoryCache{$key} = $factoryInfo;
92 } 95 }
93 96
94 { 97 {
95 no strict 'refs'; 98 no strict 'refs';
96 *{ $propInfo->Class.'::'.$propInfo->Name } = &$factory($self->RemapFactoryParams($propInfo)); 99 *{ $propInfo->Class.'::'.$propInfo->Name } = $factoryInfo->{factory}->($self->RemapFactoryParams($propInfo));
97 } 100 }
98 101
99 my $mutators = $propInfo->Mutators; 102 my $mutators = $factoryInfo->{mutators};
100 103
101 if (ref $mutators) { 104 $propInfo->canGet( $mutators->{get} ? 1 : 0 );
102 $propInfo->canGet( $mutators->{get} ? 1 : 0 ); 105 $propInfo->canSet( $mutators->{set} ? 1 : 0 );
103 $propInfo->canSet( $mutators->{set} ? 1 : 0 ); 106 $propInfo->ownerSet( $mutators->{owner} );
104 $propInfo->ownerSet(0); 107
105 } else { 108 1;
106 $propInfo->canGet( $mutators & prop_get );
107 $propInfo->canSet( $mutators & prop_set );
108 $propInfo->ownerSet( ($mutators & owner_set) == owner_set );
109 }
110 } 109 }
111 110
112 # extract from property info: class, name, get_accessor, set_accessor, validator 111 # extract from property info: class, name, get_accessor, set_accessor, validator
113 sub RemapFactoryParams { 112 sub RemapFactoryParams {
114 my ($self,$propInfo) = @_; 113 my ($self,$propInfo) = @_;