Mercurial > pub > Impl
annotate Lib/IMPL/Class/Property/Direct.pm @ 103:c289ed9662ca
Schema beta 2
More strict validation, support for inflating a simple nodes and properties
author | wizard |
---|---|
date | Fri, 07 May 2010 18:17:40 +0400 |
parents | b0c068da93ac |
children | 05df123a2ff1 |
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 | |
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 |
49 | 17 sub _direct($) { |
18 my ($prop_info) = @_; | |
19 $prop_info->Implementor( IMPL::Class::Property::Direct->new({ExportField => 1}) ); | |
20 return $prop_info; | |
21 } | |
22 | |
23 | |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
24 sub GenerateGet { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
25 'return ($this->{$field});'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
26 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
27 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
28 sub GenerateSet { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
29 'return ($this->{$field} = $_[0])'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
30 } |
49 | 31 |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
32 sub GenerateSetList { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
33 'return( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
34 wantarray ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
35 @{ $this->{$field} = IMPL::Object::List->new( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
36 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
37 )} : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
38 ($this->{$field} = IMPL::Object::List->new( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
39 (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
40 )) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
41 );'; |
49 | 42 } |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
43 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
44 sub GenerateGetList { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
45 'return( |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
46 wantarray ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
47 @{ $this->{$field} ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
48 $this->{$field} : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
49 ( $this->{$field} = IMPL::Object::List->new() ) |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
50 } : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
51 ( $this->{$field} ? |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
52 $this->{$field} : |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
53 ( $this->{$field} = IMPL::Object::List->new() ) |
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 } |
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 sub RemapFactoryParams { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
59 my ($self,$propInfo) = @_; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
60 |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
61 return $self->SUPER::RemapFactoryParams($propInfo),$self->FieldName($propInfo); |
49 | 62 } |
63 | |
64 sub Make { | |
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
65 my ($self,$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 $self->SUPER::Make($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 { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
70 no strict 'refs'; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
71 if (ref $self and $self->ExportField) { |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
72 my $field = $self->FieldName($propInfo); |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
73 *{$propInfo->Class.'::'.$propInfo->Name} = \$field; |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
74 } |
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
55
diff
changeset
|
75 } |
49 | 76 } |
77 | |
78 sub FieldName { | |
79 my ($self,$propInfo) = @_; | |
80 | |
81 my ($class,$name) = $propInfo->get qw(Class Name); | |
82 (my $field = "${class}_$name") =~ s/::/_/g; | |
83 return $field; | |
84 } | |
85 | |
86 1; |