Mercurial > pub > Impl
annotate Lib/IMPL/Class/Property/Direct.pm @ 59:0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
Configuration infrastructure in progress (in the aspect of the lazy activation)
Initial concept for the code generator
author | wizard |
---|---|
date | Tue, 09 Mar 2010 02:50:45 +0300 |
parents | 609b59c9f03c |
children | b0c068da93ac |
rev | line source |
---|---|
49 | 1 package IMPL::Class::Property::Direct; |
2 use strict; | |
3 | |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
4 use base qw(IMPL::Object::Accessor IMPL::Class::Property::Base Exporter); |
49 | 5 our @EXPORT = qw(_direct); |
6 | |
55 | 7 require IMPL::Object::List; |
49 | 8 use IMPL::Class::Property; |
9 require IMPL::Exception; | |
10 | |
11 __PACKAGE__->mk_accessors qw(ExportField); | |
12 | |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
13 push @IMPL::Class::Property::Base::factoryParams, qw($field); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
14 |
49 | 15 sub _direct($) { |
16 my ($prop_info) = @_; | |
17 $prop_info->Implementor( IMPL::Class::Property::Direct->new({ExportField => 1}) ); | |
18 return $prop_info; | |
19 } | |
20 | |
21 | |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
22 sub GenerateGet { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
23 'return ($this->{$field});'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
24 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
25 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
26 sub GenerateSet { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
27 'return ($this->{$field} = $_[0])'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
28 } |
49 | 29 |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
30 sub GenerateSetList { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
31 'return( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
32 wantarray ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
33 @{ $this->{$field} = IMPL::Object::List->new( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
34 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
35 )} : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
36 ($this->{$field} = IMPL::Object::List->new( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
37 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
38 )) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
39 );'; |
49 | 40 } |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
41 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
42 sub GenerateGetList { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
43 'return( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
44 wantarray ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
45 @{ $this->{$field} ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
46 $this->{$field} : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
47 ( $this->{$field} = IMPL::Object::List->new() ) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
48 } : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
49 ( $this->{$field} ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
50 $this->{$field} : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
51 ( $this->{$field} = IMPL::Object::List->new() ) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
52 ) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
53 );'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
54 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
55 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
56 sub RemapFactoryParams { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
57 my ($self,$propInfo) = @_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
58 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
59 return $self->SUPER::RemapFactoryParams($propInfo),$self->FieldName($propInfo); |
49 | 60 } |
61 | |
62 sub Make { | |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
63 my ($self,$propInfo) = @_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
64 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
65 $self->SUPER::Make($propInfo); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
66 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
67 { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
68 no strict 'refs'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
69 if (ref $self and $self->ExportField) { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
70 my $field = $self->FieldName($propInfo); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
71 *{$propInfo->Class.'::'.$propInfo->Name} = \$field; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
72 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
73 } |
49 | 74 } |
75 | |
76 sub FieldName { | |
77 my ($self,$propInfo) = @_; | |
78 | |
79 my ($class,$name) = $propInfo->get qw(Class Name); | |
80 (my $field = "${class}_$name") =~ s/::/_/g; | |
81 return $field; | |
82 } | |
83 | |
84 1; |