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} = IMPL::Object::List->new ( 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 parent 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