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