Mercurial > pub > Impl
annotate Lib/IMPL/Object/Autofill.pm @ 199:e743a8481327
Added REST support for forms (with only get and post methods)
| author | sergey |
|---|---|
| date | Mon, 23 Apr 2012 01:36:52 +0400 |
| parents | 2ffe6f661605 |
| children | c8fe3f84feba |
| 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 | |
| 26 my $class = ref $self || $self; | |
| 27 | |
| 28 *{"${class}::_impl_object_autofill"} = sub {}; | |
| 29 } | |
| 30 | |
| 31 sub _autofill_method { | |
| 32 my ($class) = @_; | |
| 33 | |
| 34 $class = ref $class if ref $class; | |
| 35 | |
| 180 | 36 # для автозаполнения нужен свой метод верхнего уровня |
| 49 | 37 my $method; |
| 38 { | |
| 39 no strict 'refs'; | |
| 40 $method = ${$class.'::'}{_impl_object_autofill}; | |
| 41 } | |
| 42 | |
| 43 if ($method) { | |
| 44 return $method; | |
| 45 } else { | |
| 46 my $text = <<HEADER; | |
| 47 package $class; | |
| 48 sub _impl_object_autofill { | |
| 49 my (\$this,\$fields) = \@_; | |
| 50 HEADER | |
| 51 | |
| 52 | |
| 53 if ($class->can('get_meta')) { | |
| 54 # meta supported | |
| 55 foreach my $prop_info (grep { | |
| 56 my $mutators = $_->Mutators; | |
| 57 ref $mutators ? (exists $mutators->{set}) : ($mutators & prop_set || $_->Implementor->isa('IMPL::Class::Property::Direct')); | |
| 58 } $class->get_meta('IMPL::Class::PropertyInfo')) { | |
| 59 my $name = $prop_info->Name; | |
| 60 if (ref $prop_info->Mutators || !$prop_info->Implementor->isa('IMPL::Class::Property::Direct')) { | |
| 61 $text .= "\t\$this->$name(\$fields->{$name}) if exists \$fields->{$name};\n"; | |
| 62 } else { | |
| 63 my $fld = $prop_info->Implementor->FieldName($prop_info); | |
| 64 if ($prop_info->Mutators & prop_list) { | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
49
diff
changeset
|
65 $text .= "\t\$this->{$fld} = IMPL::Object::List->new ( ref \$fields->{$name} ? \$fields->{$name} : [\$fields->{$name}] ) if exists \$fields->{$name};\n"; |
| 49 | 66 } else { |
| 67 $text .= "\t\$this->{$fld} = \$fields->{$name} if exists \$fields->{$name};\n"; | |
| 68 } | |
| 69 } | |
| 70 } | |
| 71 } else { | |
| 72 # meta not supported | |
| 73 #$text .= "\t".'$this->$_($fields->{$_}) foreach keys %$fields;'."\n"; | |
| 74 } | |
| 75 $text .= "}\n\\&_impl_object_autofill;"; | |
| 76 return eval $text; | |
| 77 } | |
| 78 } | |
| 79 | |
| 80 1; | |
| 81 | |
| 82 __END__ | |
| 83 | |
| 84 =pod | |
| 198 | 85 |
| 86 =head1 NAME | |
| 87 | |
| 88 C<IMPL::Object::Autofill> - автозаполнение объектов | |
| 89 | |
| 49 | 90 =head1 SYNOPSIS |
| 198 | 91 |
| 92 =begin code | |
| 93 | |
| 49 | 94 package MyClass; |
| 198 | 95 use IMPL::declare { |
| 96 base => { | |
| 97 'IMPL::Object' => undef, | |
| 98 'IMPL::Object::Autofill' => '@_' | |
| 99 } | |
| 100 }; | |
| 49 | 101 |
| 102 BEGIN { | |
| 103 private property PrivateData => prop_all; | |
| 104 public property PublicData => prop_get; | |
| 105 } | |
| 106 | |
| 107 sub CTOR { | |
| 108 my $this = shift; | |
| 198 | 109 |
| 49 | 110 print $this->PrivateData,"\n"; |
| 111 print $this->PublicData,"\n"; | |
| 112 } | |
| 113 | |
| 114 my $obj = new MyClass(PrivateData => 'private', PublicData => 'public', Other => 'some data'); | |
| 115 | |
| 198 | 116 #will print |
| 117 #private | |
| 118 #public | |
| 119 | |
| 120 =end code | |
| 49 | 121 |
| 122 =cut |