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