annotate Lib/IMPL/Class/Property/Direct.pm @ 52:15d720913562

security in work
author wizard@linux-odin.local
date Tue, 02 Mar 2010 20:12:02 +0300
parents 16ada169ca75
children 609b59c9f03c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
1 package IMPL::Class::Property::Direct;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
2 use strict;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
3
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
4 use base qw(IMPL::Object::Accessor Exporter);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
5 our @EXPORT = qw(_direct);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
6
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
7 use IMPL::Class::Property;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
8 require IMPL::Exception;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
9
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
10 __PACKAGE__->mk_accessors qw(ExportField);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
11
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
12 sub _direct($) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
13 my ($prop_info) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
14 $prop_info->Implementor( IMPL::Class::Property::Direct->new({ExportField => 1}) );
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
15 return $prop_info;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
16 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
17
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
18 my $access_private = "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;";
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
19 my $access_protected = "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless caller eq \$class;";
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
20
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
21 my $accessor_get_no = 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
22 my $accessor_set_no = 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
23 my $accessor_set = 'return( $this->{$field} = @_ == 1 ? $_[0] : [@_] );';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
24 my $accessor_get = 'return( $this->{$field} );';
52
15d720913562 security in work
wizard@linux-odin.local
parents: 49
diff changeset
25 my $list_accessor_set = 'return( @{ ($this->{$field} = IMPL::Object::List->new( ( (@_ == 1 and ref $_[0] eq \'ARRAY\') ? $_[0] : [@_] ) || [] ) } );';
15d720913562 security in work
wizard@linux-odin.local
parents: 49
diff changeset
26 my $list_accessor_get = 'return( @{ $this->{$field} ? $this->{$field} : $this->{$field} = IMPL::Object::List->new() } );';
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
27 my $custom_accessor_get = 'unshift @_, $this and goto &$get;';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
28 my $custom_accessor_set = 'unshift @_, $this and goto &$set;';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
29
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
30 my %accessor_cache;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
31 sub mk_acessor {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
32 my ($virtual,$access,$class,$name,$mutators,$field) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
33
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
34 my ($get,$set) = ref $mutators ? ( $mutators->{get}, $mutators->{set}) : ($mutators & prop_get, $mutators & prop_set);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
35 my $key = join '',$virtual,$access,$get ? 1 : 0,$set ? 1 : 0, (ref $mutators ? 'c' : ($mutators & prop_list() ? 'l' : 's'));
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
36 my $factory = $accessor_cache{$key};
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
37 if (not $factory) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
38 my $code =
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
39 <<BEGIN;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
40 sub {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
41 my (\$class,\$name,\$set,\$get,\$field) = \@_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
42 my \$accessor;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
43 \$accessor = sub {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
44 my \$this = shift;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
45 BEGIN
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
46 $code .= <<VCALL if $virtual;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
47 my \$method = \$this->can(\$name);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
48 return \$this->\$method(\@_) unless \$method == \$accessor or caller->isa(\$class);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
49 VCALL
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
50 $code .= "$access_private\n" if $access == IMPL::Class::Member::MOD_PRIVATE;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
51 $code .= "$access_protected\n" if $access == IMPL::Class::Member::MOD_PROTECTED;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
52 my ($codeGet,$codeSet);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
53 if (ref $mutators) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
54 $codeGet = $get ? $custom_accessor_get : $accessor_get_no;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
55 $codeSet = $set ? $custom_accessor_set : $accessor_set_no;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
56 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
57 if ($mutators & prop_list) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
58 $codeGet = $get ? $list_accessor_get : $accessor_get_no;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
59 $codeSet = $set ? $list_accessor_set : $accessor_set_no;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
60 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
61 $codeGet = $get ? $accessor_get : $accessor_get_no;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
62 $codeSet = $set ? $accessor_set : $accessor_set_no;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
63 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
64 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
65 $code .=
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
66 <<END;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
67 if (\@_) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
68 $codeSet
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
69 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
70 $codeGet
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
71 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
72 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
73 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
74 END
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
75 $factory = eval $code or die new IMPL::Exception('Failed to generate the accessor',$@);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
76 $accessor_cache{$key} = $factory;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
77 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
78 return $factory->($class,$name,$set,$get, $field);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
79 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
80
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
81 sub Make {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
82 my ($self,$propInfo) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
83
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
84 my $isExportField = ref $self ? ($self->ExportField || 0) : 0;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
85 my ($class,$name,$virt,$access,$mutators) = $propInfo->get qw(Class Name Virtual Access Mutators);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
86 (my $field = "${class}_$name") =~ s/::/_/g;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
87
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
88 my $propGlob = $class.'::'.$name;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
89
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
90 no strict 'refs';
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
91 *$propGlob = mk_acessor($virt,$access,$class,$name,$mutators,$field);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
92 *$propGlob = \$field if $isExportField;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
93
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
94 if (ref $mutators) {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
95 $propInfo->canGet( $mutators->{get} ? 1 : 0);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
96 $propInfo->canSet( $mutators->{set} ? 1 : 0);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
97 } else {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
98 $propInfo->canGet( ($mutators & prop_get) ? 1 : 0);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
99 $propInfo->canSet( ($mutators & prop_set) ? 1 : 0);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
100 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
101 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
102
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
103 sub FieldName {
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
104 my ($self,$propInfo) = @_;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
105
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
106 my ($class,$name) = $propInfo->get qw(Class Name);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
107 (my $field = "${class}_$name") =~ s/::/_/g;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
108 return $field;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
109 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
110
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
111 1;