Mercurial > pub > Impl
annotate Lib/IMPL/Object/Autofill.pm @ 355:8dfb9df07d02
added support for the custom resolvers for the TTView
| author | sergey |
|---|---|
| date | Thu, 17 Oct 2013 01:04:37 +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 |