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