Mercurial > pub > Impl
annotate Lib/IMPL/Class/Property/Direct.pm @ 215:77a9934a44af
sync, migrating to XML::Compile
| author | cin |
|---|---|
| date | Sun, 19 Aug 2012 22:27:43 +0400 |
| parents | 4d0e1962161c |
| children | 6253872024a4 |
| 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 { |
| 194 | 14 $_[0]->SUPER::factoryParams, qw($field); |
|
60
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 { |
| 194 | 27 'return ($this->{$field});'; |
|
59
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 { |
| 194 | 31 'return ($this->{$field} = $_[0])'; |
|
59
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 { |
| 194 | 35 'return( |
| 36 wantarray ? | |
| 37 @{ $this->{$field} = IMPL::Object::List->new( | |
| 38 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] | |
| 39 )} : | |
| 40 ($this->{$field} = IMPL::Object::List->new( | |
| 41 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] | |
| 42 )) | |
| 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 { |
| 194 | 47 'return( |
| 48 wantarray ? | |
| 49 @{ $this->{$field} ? | |
| 50 $this->{$field} : | |
| 51 ( $this->{$field} = IMPL::Object::List->new() ) | |
| 52 } : | |
| 53 ( $this->{$field} ? | |
| 54 $this->{$field} : | |
| 55 ( $this->{$field} = IMPL::Object::List->new() ) | |
| 56 ) | |
| 57 );'; | |
|
59
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 { |
| 194 | 61 my ($self,$propInfo) = @_; |
| 62 | |
| 63 return $self->SUPER::RemapFactoryParams($propInfo),$self->FieldName($propInfo); | |
| 49 | 64 } |
| 65 | |
| 66 sub Make { | |
| 194 | 67 my ($self,$propInfo) = @_; |
| 68 | |
| 69 $self->SUPER::Make($propInfo); | |
| 70 | |
| 71 { | |
| 72 no strict 'refs'; | |
| 73 if (ref $self and $self->ExportField) { | |
| 74 my $field = $self->FieldName($propInfo); | |
| 75 *{$propInfo->Class.'::'.$propInfo->Name} = \$field; | |
| 76 } | |
| 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; |