Mercurial > pub > Impl
diff lib/IMPL/Object/Autofill.pm @ 407:c6e90e02dd17 ref20150831
renamed Lib->lib
author | cin |
---|---|
date | Fri, 04 Sep 2015 19:40:23 +0300 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/IMPL/Object/Autofill.pm Fri Sep 04 19:40:23 2015 +0300 @@ -0,0 +1,128 @@ +package IMPL::Object::Autofill; +use strict; +use Carp qw(cluck); + +BEGIN { + cluck "The autofilling is obsolete use explicit object initializers"; +} + +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