view Lib/IMPL/Object/Autofill.pm @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +0400
parents 47f77e6409f7
children 6253872024a4
line wrap: on
line source

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;
    
    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('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 .= "    \$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 .= "    \$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