Mercurial > pub > Impl
annotate Lib/IMPL/Class/Property/Direct.pm @ 193:8e8401c0aea4
sync
author | sergey |
---|---|
date | Tue, 10 Apr 2012 08:13:22 +0400 |
parents | d1676be8afcc |
children | 4d0e1962161c |
rev | line source |
---|---|
49 | 1 package IMPL::Class::Property::Direct; |
2 use strict; | |
3 | |
165 | 4 use parent qw(Exporter IMPL::Object::Accessor IMPL::Class::Property::Base); |
49 | 5 our @EXPORT = qw(_direct); |
6 | |
55 | 7 require IMPL::Object::List; |
49 | 8 use IMPL::Class::Property; |
9 require IMPL::Exception; | |
10 | |
179 | 11 __PACKAGE__->mk_accessors( qw(ExportField) ); |
49 | 12 |
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
13 sub factoryParams { |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
14 $_[0]->SUPER::factoryParams, qw($field); |
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
15 } |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
16 |
180 | 17 my $default = __PACKAGE__->new({ExportField => 1}); |
18 | |
49 | 19 sub _direct($) { |
20 my ($prop_info) = @_; | |
180 | 21 $prop_info->Implementor( $default ); |
49 | 22 return $prop_info; |
23 } | |
24 | |
25 | |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
26 sub GenerateGet { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
27 'return ($this->{$field});'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
28 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
29 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
30 sub GenerateSet { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
31 'return ($this->{$field} = $_[0])'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
32 } |
49 | 33 |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
34 sub GenerateSetList { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
35 'return( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
36 wantarray ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
37 @{ $this->{$field} = IMPL::Object::List->new( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
38 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
39 )} : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
40 ($this->{$field} = IMPL::Object::List->new( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
41 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
42 )) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
43 );'; |
49 | 44 } |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
45 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
46 sub GenerateGetList { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
47 'return( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
48 wantarray ? |
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 ( $this->{$field} ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
54 $this->{$field} : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
55 ( $this->{$field} = IMPL::Object::List->new() ) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
56 ) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
57 );'; |
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 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
60 sub RemapFactoryParams { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
61 my ($self,$propInfo) = @_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
62 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
63 return $self->SUPER::RemapFactoryParams($propInfo),$self->FieldName($propInfo); |
49 | 64 } |
65 | |
66 sub Make { | |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
67 my ($self,$propInfo) = @_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
68 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
69 $self->SUPER::Make($propInfo); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
70 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
71 { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
72 no strict 'refs'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
73 if (ref $self and $self->ExportField) { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
74 my $field = $self->FieldName($propInfo); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
75 *{$propInfo->Class.'::'.$propInfo->Name} = \$field; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
76 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
77 } |
49 | 78 } |
79 | |
80 sub FieldName { | |
81 my ($self,$propInfo) = @_; | |
82 | |
179 | 83 my ($class,$name) = $propInfo->get( qw(Class Name) ); |
49 | 84 (my $field = "${class}_$name") =~ s/::/_/g; |
85 return $field; | |
86 } | |
87 | |
88 1; |