Mercurial > pub > Impl
view Lib/IMPL/Object/Autofill.pm @ 310:0a9d51cf6dfd
*TTView: refactoring, document supports custom classes, layouts are become controls
author | sergey |
---|---|
date | Fri, 19 Apr 2013 16:39:01 +0400 |
parents | 4ddb27ff4a0b |
children |
line wrap: on
line source
package IMPL::Object::Autofill; use strict; use IMPL::Const qw(:access); 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('GetMeta')) { # meta supported foreach my $prop_info (grep { $_->setter && ($_->access & ACCESS_PUBLIC); } $class->GetMeta('IMPL::Class::PropertyInfo')) { my $name = $prop_info->name; if ($prop_info->isa('IMPL::Class::DirectPropertyInfo')) { $text .= " \$this->$name(\$fields->{$name}) if exists \$fields->{$name};\n"; } else { my $fld = $prop_info->fieldName; if ($prop_info->isList) { $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