Mercurial > pub > Impl
annotate Lib/IMPL/Object/Autofill.pm @ 269:dacfe7c0311a
SQL schema updated (unstable)
| author | sergey |
|---|---|
| date | Thu, 24 Jan 2013 20:00:27 +0400 |
| parents | 47f77e6409f7 |
| children | 6253872024a4 |
| rev | line source |
|---|---|
| 49 | 1 package IMPL::Object::Autofill; |
| 2 use strict; | |
| 3 use IMPL::Class::Property; | |
| 4 | |
| 5 sub CTOR { | |
| 6 my $this = shift; | |
| 7 no strict 'refs'; | |
| 8 | |
| 9 my $fields = @_ == 1 ? $_[0] : {@_}; | |
| 10 | |
| 11 $this->_fill(ref $this,$fields); | |
| 12 } | |
| 13 | |
| 14 sub _fill { | |
| 15 my ($this,$class,$fields) = @_; | |
| 16 | |
| 17 $class->_autofill_method->($this,$fields); | |
| 18 | |
| 19 no strict 'refs'; | |
| 20 $this->_fill($_,$fields) foreach grep $_->isa('IMPL::Object::Autofill'), @{"${class}::ISA"}; | |
| 21 } | |
| 22 | |
| 23 sub DisableAutofill { | |
| 24 my $self = shift; | |
| 25 | |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
26 no strict 'refs'; |
| 49 | 27 my $class = ref $self || $self; |
| 28 | |
| 29 *{"${class}::_impl_object_autofill"} = sub {}; | |
| 30 } | |
| 31 | |
| 32 sub _autofill_method { | |
| 33 my ($class) = @_; | |
| 34 | |
| 35 $class = ref $class if ref $class; | |
| 36 | |
| 180 | 37 # для автозаполнения нужен свой метод верхнего уровня |
| 49 | 38 my $method; |
| 39 { | |
| 40 no strict 'refs'; | |
| 41 $method = ${$class.'::'}{_impl_object_autofill}; | |
| 42 } | |
| 43 | |
| 44 if ($method) { | |
| 45 return $method; | |
| 46 } else { | |
| 47 my $text = <<HEADER; | |
| 48 package $class; | |
| 49 sub _impl_object_autofill { | |
| 50 my (\$this,\$fields) = \@_; | |
| 51 HEADER | |
| 52 | |
| 53 | |
| 54 if ($class->can('get_meta')) { | |
| 55 # meta supported | |
| 56 foreach my $prop_info (grep { | |
| 57 my $mutators = $_->Mutators; | |
| 58 ref $mutators ? (exists $mutators->{set}) : ($mutators & prop_set || $_->Implementor->isa('IMPL::Class::Property::Direct')); | |
| 59 } $class->get_meta('IMPL::Class::PropertyInfo')) { | |
| 60 my $name = $prop_info->Name; | |
| 61 if (ref $prop_info->Mutators || !$prop_info->Implementor->isa('IMPL::Class::Property::Direct')) { | |
| 206 | 62 $text .= " \$this->$name(\$fields->{$name}) if exists \$fields->{$name};\n"; |
| 49 | 63 } else { |
| 64 my $fld = $prop_info->Implementor->FieldName($prop_info); | |
| 65 if ($prop_info->Mutators & prop_list) { | |
| 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 |