view Lib/IMPL/Object/Autofill.pm @ 245:7c517134c42f

Added Unsupported media type Web exception corrected resourceLocation setting in the resource Implemented localizable resources for text messages fixed TT view scopings, INIT block in controls now sets globals correctly.
author sergey
date Mon, 29 Oct 2012 03:15:22 +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