Mercurial > pub > Impl
annotate Lib/IMPL/Object/Autofill.pm @ 365:7c621bb95e53
working on the metadata model
author | sergey |
---|---|
date | Mon, 02 Dec 2013 02:13:12 +0400 |
parents | 4ddb27ff4a0b |
children |
rev | line source |
---|---|
49 | 1 package IMPL::Object::Autofill; |
2 use strict; | |
278 | 3 |
4 use IMPL::Const qw(:access); | |
49 | 5 |
6 sub CTOR { | |
7 my $this = shift; | |
8 no strict 'refs'; | |
9 | |
10 my $fields = @_ == 1 ? $_[0] : {@_}; | |
11 | |
12 $this->_fill(ref $this,$fields); | |
13 } | |
14 | |
15 sub _fill { | |
16 my ($this,$class,$fields) = @_; | |
17 | |
18 $class->_autofill_method->($this,$fields); | |
19 | |
20 no strict 'refs'; | |
21 $this->_fill($_,$fields) foreach grep $_->isa('IMPL::Object::Autofill'), @{"${class}::ISA"}; | |
22 } | |
23 | |
24 sub DisableAutofill { | |
25 my $self = shift; | |
26 | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
27 no strict 'refs'; |
49 | 28 my $class = ref $self || $self; |
29 | |
30 *{"${class}::_impl_object_autofill"} = sub {}; | |
31 } | |
32 | |
33 sub _autofill_method { | |
34 my ($class) = @_; | |
35 | |
36 $class = ref $class if ref $class; | |
37 | |
180 | 38 # для автозаполнения нужен свой метод верхнего уровня |
49 | 39 my $method; |
40 { | |
41 no strict 'refs'; | |
42 $method = ${$class.'::'}{_impl_object_autofill}; | |
43 } | |
44 | |
45 if ($method) { | |
46 return $method; | |
47 } else { | |
48 my $text = <<HEADER; | |
49 package $class; | |
50 sub _impl_object_autofill { | |
51 my (\$this,\$fields) = \@_; | |
52 HEADER | |
53 | |
54 | |
278 | 55 if ($class->can('GetMeta')) { |
49 | 56 # meta supported |
57 foreach my $prop_info (grep { | |
278 | 58 $_->setter && ($_->access & ACCESS_PUBLIC); |
59 } $class->GetMeta('IMPL::Class::PropertyInfo')) { | |
275 | 60 my $name = $prop_info->name; |
278 | 61 if ($prop_info->isa('IMPL::Class::DirectPropertyInfo')) { |
206 | 62 $text .= " \$this->$name(\$fields->{$name}) if exists \$fields->{$name};\n"; |
49 | 63 } else { |
278 | 64 my $fld = $prop_info->fieldName; |
65 if ($prop_info->isList) { | |
206 | 66 $text .= " \$this->{$fld} = IMPL::Object::List->new ( ref \$fields->{$name} ? \$fields->{$name} : [\$fields->{$name}] ) if exists \$fields->{$name};\n"; |
49 | 67 } else { |
206 | 68 $text .= " \$this->{$fld} = \$fields->{$name} if exists \$fields->{$name};\n"; |
49 | 69 } |
70 } | |
71 } | |
72 } else { | |
73 # meta not supported | |
206 | 74 #$text .= " ".'$this->$_($fields->{$_}) foreach keys %$fields;'."\n"; |
49 | 75 } |
76 $text .= "}\n\\&_impl_object_autofill;"; | |
77 return eval $text; | |
78 } | |
79 } | |
80 | |
81 1; | |
82 | |
83 __END__ | |
84 | |
85 =pod | |
198 | 86 |
87 =head1 NAME | |
88 | |
89 C<IMPL::Object::Autofill> - автозаполнение объектов | |
90 | |
49 | 91 =head1 SYNOPSIS |
198 | 92 |
93 =begin code | |
94 | |
49 | 95 package MyClass; |
198 | 96 use IMPL::declare { |
97 base => { | |
98 'IMPL::Object' => undef, | |
99 'IMPL::Object::Autofill' => '@_' | |
100 } | |
101 }; | |
49 | 102 |
103 BEGIN { | |
104 private property PrivateData => prop_all; | |
105 public property PublicData => prop_get; | |
106 } | |
107 | |
108 sub CTOR { | |
109 my $this = shift; | |
198 | 110 |
49 | 111 print $this->PrivateData,"\n"; |
112 print $this->PublicData,"\n"; | |
113 } | |
114 | |
115 my $obj = new MyClass(PrivateData => 'private', PublicData => 'public', Other => 'some data'); | |
116 | |
198 | 117 #will print |
118 #private | |
119 #public | |
120 | |
121 =end code | |
49 | 122 |
123 =cut |