--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Object/Autofill.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,110 @@
+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;
+    
+    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 .= "\t\$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 .= "\t\$this->{$fld} = ref \$fields->{$name} ? \$fields->{$name} : [\$fields->{$name}] if exists \$fields->{$name};\n";
+                    } else {
+                        $text .= "\t\$this->{$fld} = \$fields->{$name} if exists \$fields->{$name};\n";
+                    }
+                }
+            }
+        } else {
+            # meta not supported
+            #$text .= "\t".'$this->$_($fields->{$_}) foreach keys %$fields;'."\n";
+        }
+        $text .= "}\n\\&_impl_object_autofill;";
+        return eval $text;
+    }
+}
+
+1;
+
+__END__
+
+=pod
+=head1 SYNOPSIS
+package MyClass;
+use base qw(IMPL::Object IMPL::Object::Autofill);
+
+BEGIN {
+    private property PrivateData => prop_all;
+    public property PublicData => prop_get;
+}
+
+sub CTOR {
+    my $this = shift;
+    $this->superCTOR(@_);
+    # or eqvivalent
+    # $this->supercall::CTOR(@_);
+
+    print $this->PrivateData,"\n";
+    print $this->PublicData,"\n";
+}
+
+my $obj = new MyClass(PrivateData => 'private', PublicData => 'public', Other => 'some data');
+
+will print
+private
+public
+
+=cut
\ No newline at end of file