Mercurial > pub > Impl
view Lib/IMPL/Object/Autofill.pm @ 277:6585464c4664
sync (unstable)
author | sergey |
---|---|
date | Fri, 01 Feb 2013 16:37:59 +0400 |
parents | 6253872024a4 |
children | 4ddb27ff4a0b |
line wrap: on
line source
package IMPL::Object::Autofill; use strict; use IMPL::Class::Property; sub CTOR { my $this = shift; no strict 'refs'; my $fields = @_ == 1 ? $_[0] : {@_}; $this->_fill(ref $this,$fields); } sub _fill { my ($this,$class,$fields) = @_; $class->_autofill_method->($this,$fields); no strict 'refs'; $this->_fill($_,$fields) foreach grep $_->isa('IMPL::Object::Autofill'), @{"${class}::ISA"}; } sub DisableAutofill { my $self = shift; no strict 'refs'; my $class = ref $self || $self; *{"${class}::_impl_object_autofill"} = sub {}; } sub _autofill_method { my ($class) = @_; $class = ref $class if ref $class; # для автозаполнения нужен свой метод верхнего уровня my $method; { no strict 'refs'; $method = ${$class.'::'}{_impl_object_autofill}; } if ($method) { return $method; } else { my $text = <<HEADER; package $class; sub _impl_object_autofill { my (\$this,\$fields) = \@_; HEADER if ($class->can('get_meta')) { # meta supported foreach my $prop_info (grep { my $mutators = $_->mutators; ref $mutators ? (exists $mutators->{set}) : ($mutators & prop_set || $_->implementor->isa('IMPL::Class::Property::Direct')); } $class->get_meta('IMPL::Class::PropertyInfo')) { my $name = $prop_info->name; if (ref $prop_info->mutators || !$prop_info->implementor->isa('IMPL::Class::Property::Direct')) { $text .= " \$this->$name(\$fields->{$name}) if exists \$fields->{$name};\n"; } else { my $fld = $prop_info->implementor->FieldName($prop_info); if ($prop_info->mutators & prop_list) { $text .= " \$this->{$fld} = IMPL::Object::List->new ( ref \$fields->{$name} ? \$fields->{$name} : [\$fields->{$name}] ) if exists \$fields->{$name};\n"; } else { $text .= " \$this->{$fld} = \$fields->{$name} if exists \$fields->{$name};\n"; } } } } else { # meta not supported #$text .= " ".'$this->$_($fields->{$_}) foreach keys %$fields;'."\n"; } $text .= "}\n\\&_impl_object_autofill;"; return eval $text; } } 1; __END__ =pod =head1 NAME C<IMPL::Object::Autofill> - автозаполнение объектов =head1 SYNOPSIS =begin code package MyClass; use IMPL::declare { base => { 'IMPL::Object' => undef, 'IMPL::Object::Autofill' => '@_' } }; BEGIN { private property PrivateData => prop_all; public property PublicData => prop_get; } sub CTOR { my $this = shift; print $this->PrivateData,"\n"; print $this->PublicData,"\n"; } my $obj = new MyClass(PrivateData => 'private', PublicData => 'public', Other => 'some data'); #will print #private #public =end code =cut