# HG changeset patch # User cin # Date 1359584311 -14400 # Node ID 6253872024a4eb7b340a57dab8e2b2892f532dc7 # Parent 8d36073411b11e635fa61dec7a75901c4e40a7c6 *refactoring IMPL::Class diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/Class/Member.pm --- 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]; } diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/Class/MemberInfo.pm --- 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 -Устанавливает C в C<1>, добавляет в метаданные класса. - При реализации собственного субкласса, данный метод может быть переопределен для реализации дополнительной обработки (например, создание методов доступа для свойств). diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/Class/Property.pm --- 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; }; diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/Class/Property/Accessor.pm --- 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 { diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/Class/Property/Base.pm --- 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; diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/Class/Property/Direct.pm --- 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; } diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/Class/PropertyInfo.pm --- 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; diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/DOM/Node.pm --- 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}}); } diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/DOM/Property.pm --- 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; } diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/Object/AutoDispose.pm --- 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+)$/); diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/Object/Autofill.pm --- 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"; diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/Test.pm --- 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($;@) { diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/declare.pm --- 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 } diff -r 8d36073411b1 -r 6253872024a4 Lib/IMPL/lang.pm --- 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;