Mercurial > pub > Impl

changeset 275:6253872024a4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*refactoring IMPL::Class
author cin
date Thu, 31 Jan 2013 02:18:31 +0400
parents 8d36073411b1
children 8a5da17d7ef9
files Lib/IMPL/Class/Member.pm Lib/IMPL/Class/MemberInfo.pm Lib/IMPL/Class/Property.pm Lib/IMPL/Class/Property/Accessor.pm Lib/IMPL/Class/Property/Base.pm Lib/IMPL/Class/Property/Direct.pm Lib/IMPL/Class/PropertyInfo.pm Lib/IMPL/DOM/Node.pm Lib/IMPL/DOM/Property.pm Lib/IMPL/Object/AutoDispose.pm Lib/IMPL/Object/Autofill.pm Lib/IMPL/Test.pm Lib/IMPL/declare.pm Lib/IMPL/lang.pm
diffstat 14 files changed, 66 insertions(+), 106 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/Class/Member.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/Class/Member.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -13,25 +13,20 @@
     MOD_PRIVATE => 3
 };
 
-sub virtual($) {
-    $_[0]->Virtual(1);
-    $_[0];
-}
-
 sub public($) {
-    $_[0]->Access(MOD_PUBLIC);
+    $_[0]->access(MOD_PUBLIC);
     $_[0]->Implement;
     $_[0];
 }
 
 sub private($) {
-    $_[0]->Access(MOD_PRIVATE);
+    $_[0]->access(MOD_PRIVATE);
     $_[0]->Implement;
     $_[0];
 }
 
 sub protected($) {
-    $_[0]->Access(MOD_PROTECTED);
+    $_[0]->access(MOD_PROTECTED);
     $_[0]->Implement;
     $_[0];
 }
--- a/Lib/IMPL/Class/MemberInfo.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/Class/MemberInfo.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -6,12 +6,11 @@
 
 __PACKAGE__->mk_accessors(
     qw(
-        Name
-        Access
-        Class
-        Frozen
-        Implementor
-        Attributes
+        name
+        access
+        class
+        implementor
+        attributes
     )
 );
 __PACKAGE__->PassThroughArgs;
@@ -19,30 +18,20 @@
 sub CTOR {
     my $this = shift;
     
-    die new IMPL::Exception('The name is required for the member') unless $this->Name;
-    die new IMPL::Exception('The class is required for the member') unless $this->Class;
+    die new IMPL::Exception('The name is required for the member') unless $this->name;
+    die new IMPL::Exception('The class is required for the member') unless $this->class;
     
-    $this->Attributes({}) unless defined $this->Attributes;
-    $this->Frozen(0);
-    $this->Access(3) unless $this->Access;
+    $this->attributes({}) unless defined $this->attributes;
+    $this->access(3) unless $this->access;
 }
 
 sub Implement {
     my ($this) = @_;
-    $this->Implementor->Make($this);
-    $this->Frozen(1);
-    $this->Class->set_meta($this);
+    $this->implementor->Make($this);
+    $this->class->set_meta($this);
     return;
 }
 
-sub access {
-    goto &Access;
-}
-
-sub name {
-    goto &Name;
-}
-
 1;
 
 __END__
@@ -64,32 +53,26 @@
 
 =over
 
-=item C<[get,set] Name>
+=item C<[get,set] name>
 
 Имя члена.
 
-=item C<[get,set] Access>
+=item C<[get,set] access>
 
 Default public.
 
 Атрибут доступа ( public | private | protected )
 
-=item C<[get,set] Class>
+=item C<[get,set] class>
 
 Класс владелец
         
-=item C<[get,set] Frozen>
-
-Флаг невозможности внесения изменений
-
-=item C<[get,set] Attributes>
+=item C<[get,set] attributes>
 
 Дополнительные атрибуты
 
 =item C<Implement()>
 
-Устанавливает C<Frozen> в C<1>, добавляет в метаданные класса.
-
 При реализации собственного субкласса, данный метод может быть переопределен для
 реализации дополнительной обработки (например, создание методов доступа для свойств).
 
--- a/Lib/IMPL/Class/Property.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/Class/Property.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -22,13 +22,13 @@
 
 sub property($$;$) {
     my ($propName,$mutators,$attributes) = @_;
-    my $Info = new IMPL::Class::PropertyInfo( {Name => $propName, Mutators => $mutators, Class => scalar(caller), Attributes => $attributes } );
+    my $Info = new IMPL::Class::PropertyInfo( {name => $propName, mutators => $mutators, class => scalar(caller), attributes => $attributes } );
     return $Info;
 }
 
 sub CreateProperty {
     my ($class,$propName,$mutators,$attributes) = @_;
-    my $Info = new IMPL::Class::PropertyInfo( {Name => $propName, Mutators => $mutators, Class => $class, Attributes => $attributes} );
+    my $Info = new IMPL::Class::PropertyInfo( {name => $propName, mutators => $mutators, class => $class, attributes => $attributes} );
     return $Info;
 };
 
--- a/Lib/IMPL/Class/Property/Accessor.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/Class/Property/Accessor.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -9,7 +9,7 @@
 sub RemapFactoryParams {
     my ($self,$propInfo) = @_;
     
-    return $self->SUPER::RemapFactoryParams($propInfo),$propInfo->Name;
+    return $self->SUPER::RemapFactoryParams($propInfo),$propInfo->name;
 }
 
 sub GenerateGet {
--- a/Lib/IMPL/Class/Property/Base.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/Class/Property/Base.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -78,11 +78,11 @@
     my $factoryInfo = $factoryCache{$key};
     
     unless ($factoryInfo) {
-        my $mutators = $self->GenerateAccessors($propInfo->Mutators);
+        my $mutators = $self->GenerateAccessors($propInfo->mutators);
         $factoryInfo = {
             factory => $self->CreateFactory(
-                $access_code{ $propInfo->Access },
-                $propInfo->Attributes->{validator} ? $validator_code : "",
+                $access_code{ $propInfo->access },
+                $propInfo->attributes->{validator} ? $validator_code : "",
                 $mutators->{owner},
                 $mutators->{get} || $accessor_get_no,
                 $mutators->{set} || $accessor_set_no
@@ -94,7 +94,7 @@
     
     {
         no strict 'refs';
-        *{ $propInfo->Class.'::'.$propInfo->Name } = $factoryInfo->{factory}->($self->RemapFactoryParams($propInfo));
+        *{ $propInfo->class.'::'.$propInfo->name } = $factoryInfo->{factory}->($self->RemapFactoryParams($propInfo));
     }
     
     my $mutators = $factoryInfo->{mutators};
@@ -114,14 +114,14 @@
 sub RemapFactoryParams {
     my ($self,$propInfo) = @_;
     
-    my $mutators = $propInfo->Mutators;
-    my $class = $propInfo->Class;
-    my $validator = $propInfo->Attributes->{validator};
+    my $mutators = $propInfo->mutators;
+    my $class = $propInfo->class;
+    my $validator = $propInfo->attributes->{validator};
     
     die new IMPL::Exception('Can\'t find the specified validator',$class,$validator) if $validator and ref $validator ne 'CODE' and not $class->can($validator);
 
     return (
-        $propInfo->get(qw(Class Name)),
+        $propInfo->get(qw(class name)),
         (ref $mutators?
             ($mutators->{set},$mutators->{get})
             :
@@ -134,7 +134,7 @@
 sub MakeFactoryKey {
     my ($self,$propInfo) = @_;
     
-    my ($access,$mutators,$validator) = ($propInfo->get(qw(Access Mutators)),$propInfo->Attributes->{validator});
+    my ($access,$mutators,$validator) = ($propInfo->get(qw(access mutators)),$propInfo->attributes->{validator});
     
     my $implementor = ref $self || $self;
     
--- a/Lib/IMPL/Class/Property/Direct.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/Class/Property/Direct.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -18,7 +18,7 @@
 
 sub _direct($) {
     my ($prop_info) = @_;
-    $prop_info->Implementor( $default );
+    $prop_info->implementor( $default );
     return $prop_info;
 }
 
@@ -72,7 +72,7 @@
         no strict 'refs';
         if (ref $self and $self->ExportField) {
             my $field = $self->FieldName($propInfo);
-            *{$propInfo->Class.'::'.$propInfo->Name} = \$field;
+            *{$propInfo->class.'::'.$propInfo->name} = \$field;
         }
     }
 }
@@ -80,7 +80,7 @@
 sub FieldName {
     my ($self,$propInfo) = @_;
     
-    my ($class,$name) = $propInfo->get( qw(Class Name) );
+    my ($class,$name) = $propInfo->get( qw(class name) );
     (my $field = "${class}_$name") =~ s/::/_/g;
     return $field;
 }
--- a/Lib/IMPL/Class/PropertyInfo.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/Class/PropertyInfo.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -5,42 +5,38 @@
 
 our %CTOR = ( 'IMPL::Class::MemberInfo' => '@_' );
 
-__PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet ownerSet isList));
+__PACKAGE__->mk_accessors(qw(type mutators canGet canSet ownerSet isList));
 
 my %LoadedModules;
 
 sub CTOR {
     my $this = shift;
     
-    if ( my $type = $this->Attributes ? delete $this->Attributes->{type} : undef ) {
-        $this->Type($type);
+    if ( my $type = $this->attributes ? delete $this->attributes->{type} : undef ) {
+        $this->type($type);
     }
     
-    $this->Mutators(0) unless defined $this->Mutators;
+    $this->mutators(0) unless defined $this->mutators;
 }
 
-sub Implementor {
+sub implementor {
     my $this = shift;
         
     if (@_) {
-        $this->SUPER::Implementor(@_);
+        $this->SUPER::implementor(@_);
     } else {
-        my $implementor = $this->SUPER::Implementor;
+        my $implementor = $this->SUPER::implementor;
         return $implementor if $implementor;
         
         $implementor = $this->SelectImplementor();
         
-        $this->Implementor($implementor);
+        $this->implementor($implementor);
     }
     
 }
 
 sub SelectImplementor {
-    eval {$_[0]->Class->_PropertyImplementor} or die new IMPL::Exception('Can\'t find a property implementor for the specified class',$_[0]->Class);
-}
-
-sub type {
-    goto &Type;
+    eval {$_[0]->class->_PropertyImplementor} or die new IMPL::Exception('Can\'t find a property implementor for the specified class',$_[0]->Class);
 }
 
 1;
--- a/Lib/IMPL/DOM/Node.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -388,7 +388,7 @@
 sub listProperties {
     my ($this) = @_;
     
-    my %props = map {$_->Name, 1} $this->get_meta(typeof IMPL::Class::PropertyInfo, sub { $_->Attributes->{domProperty}},1);
+    my %props = map {$_->name, 1} $this->GetMeta(typeof IMPL::Class::PropertyInfo, sub { $_->attributes->{domProperty}},1);
     
     return (keys %props,keys %{$this->{$_propertyMap}});
 }
--- a/Lib/IMPL/DOM/Property.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/DOM/Property.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -9,7 +9,7 @@
 
 sub _dom($) {
     my ($prop_info) = @_;
-    $prop_info->Attributes->{domProperty} = 1;
+    $prop_info->attributes->{domProperty} = 1;
     return $prop_info;
 }
 
--- a/Lib/IMPL/Object/AutoDispose.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/Object/AutoDispose.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -1,12 +1,6 @@
 package IMPL::Object::AutoDispose;
 use strict;
 
-use IMPL::declare {
-    base => [
-        'IMPL::Object::Abstract' => undef
-    ]
-};
-
 sub new {
     my $self = shift;
         
@@ -26,18 +20,10 @@
     ${shift(@_)}->can(@_);
 }
 
-sub DTOR {
+sub DESTROY {
     ${shift(@_)}->Dispose();
 }
 
-sub typeof {
-    ${shift(@_)}->typeof(@_);
-}
-
-sub toString {
-    ${shift(@_)}->toString(@_);
-}
-
 sub AUTOLOAD {
     our $AUTOLOAD;
     my ($method) = ($AUTOLOAD =~ m/(\w+)$/);
--- a/Lib/IMPL/Object/Autofill.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/Object/Autofill.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -54,15 +54,15 @@
         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'));
+                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')) {
+                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) {
+                    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";
--- a/Lib/IMPL/Test.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/Test.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -27,11 +27,11 @@
     
     my $class = caller;
     
-    die new IMPL::Exception("Only properties could be declared as shared",$propInfo->Name) unless eval {$propInfo->isa('IMPL::Class::PropertyInfo')};
-    die new IMPL::Exception("You can't mark the readonly property as shared",$propInfo->Name) unless $propInfo->canSet;
-    die new IMPL::Exception("Only public properties could be declared as shared",$propInfo->Name) unless $propInfo->Access == IMPL::Class::Member::MOD_PUBLIC;
+    die new IMPL::Exception("Only properties could be declared as shared",$propInfo->name) unless eval {$propInfo->isa('IMPL::Class::PropertyInfo')};
+    die new IMPL::Exception("You can't mark the readonly property as shared",$propInfo->name) unless $propInfo->canSet;
+    die new IMPL::Exception("Only public properties could be declared as shared",$propInfo->name) unless $propInfo->access == IMPL::Class::Member::MOD_PUBLIC;
     
-    $class->set_meta(new IMPL::Test::Unit::SharedData($propInfo->Name));
+    $class->set_meta(new IMPL::Test::Unit::SharedData($propInfo->name));
 }
 
 sub failed($;@) {
--- a/Lib/IMPL/declare.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/declare.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -108,10 +108,10 @@
 
         my $propInfo = IMPL::Class::PropertyInfo->new(
             {
-                Name     => $prop,
-                Mutators => $spec,
-                Class    => $caller,
-                Access   => $prop =~ /^_/
+                name     => $prop,
+                mutators => $spec,
+                class    => $caller,
+                access   => $prop =~ /^_/
                 ? ACCESS_PRIVATE
                 : ACCESS_PUBLIC
             }
--- a/Lib/IMPL/lang.pm	Wed Jan 30 03:30:28 2013 +0400
+++ b/Lib/IMPL/lang.pm	Thu Jan 31 02:18:31 2013 +0400
@@ -82,19 +82,19 @@
 }
 
 sub public($) {
-    $_[0]->Access(ACCESS_PUBLIC);
+    $_[0]->access(ACCESS_PUBLIC);
     $_[0]->Implement;
     $_[0];
 }
 
 sub private($) {
-    $_[0]->Access(ACCESS_PRIVATE);
+    $_[0]->access(ACCESS_PRIVATE);
     $_[0]->Implement;
     $_[0];
 }
 
 sub protected($) {
-    $_[0]->Access(ACCESS_PROTECTED);
+    $_[0]->access(ACCESS_PROTECTED);
     $_[0]->Implement;
     $_[0];
 }
@@ -103,10 +103,10 @@
     my ( $propName, $mutators, $attributes ) = @_;
     my $Info = new IMPL::Class::PropertyInfo(
         {
-            Name       => $propName,
-            Mutators   => $mutators,
-            Class      => scalar(caller),
-            Attributes => $attributes
+            name       => $propName,
+            mutators   => $mutators,
+            class      => scalar(caller),
+            attributes => $attributes
         }
     );
     return $Info;