Mercurial > pub > Impl
annotate Lib/IMPL/Class/Property/Direct.pm @ 206:c8fe3f84feba
+IMPL::Web::Handlers::ViewSelector
+IMPL::Web::Handlers::ErrorHandler
*IMPL::Web::Handlers::RestController moved types mappings to ViewSelector
author | sergey |
---|---|
date | Thu, 03 May 2012 16:48:39 +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; |