Mercurial > pub > Impl
annotate Lib/IMPL/Object/Autofill.pm @ 166:4267a2ac3d46
Added Class::Template,
Rewritten SQL::Schema
'use parent' directive instead of 'use base'
| author | wizard |
|---|---|
| date | Sat, 23 Apr 2011 23:12:06 +0400 |
| parents | e6447ad85cb4 |
| children | d1676be8afcc |
| 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 | |
| 36 # для автозаполнения нужен свой метод верхнего уровня | |
| 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 | |
| 85 =head1 SYNOPSIS | |
| 86 package MyClass; | |
| 166 | 87 use parent qw(IMPL::Object IMPL::Object::Autofill); |
| 49 | 88 |
| 89 BEGIN { | |
| 90 private property PrivateData => prop_all; | |
| 91 public property PublicData => prop_get; | |
| 92 } | |
| 93 | |
| 94 sub CTOR { | |
| 95 my $this = shift; | |
| 96 $this->superCTOR(@_); | |
| 97 # or eqvivalent | |
| 98 # $this->supercall::CTOR(@_); | |
| 99 | |
| 100 print $this->PrivateData,"\n"; | |
| 101 print $this->PublicData,"\n"; | |
| 102 } | |
| 103 | |
| 104 my $obj = new MyClass(PrivateData => 'private', PublicData => 'public', Other => 'some data'); | |
| 105 | |
| 106 will print | |
| 107 private | |
| 108 public | |
| 109 | |
| 110 =cut |