Mercurial > pub > Impl
diff Lib/IMPL/Object/Autofill.pm @ 49:16ada169ca75
migrating to the Eclipse IDE
author | wizard@linux-odin.local |
---|---|
date | Fri, 26 Feb 2010 10:49:21 +0300 |
parents | 03e58a454b20 |
children | e6447ad85cb4 |
line wrap: on
line diff
--- a/Lib/IMPL/Object/Autofill.pm Fri Feb 26 01:43:42 2010 +0300 +++ b/Lib/IMPL/Object/Autofill.pm Fri Feb 26 10:49:21 2010 +0300 @@ -1,110 +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 +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