# HG changeset patch # User Sergey # Date 1250084167 -14400 # Node ID e59f44f75f20d15c26deb3328489a9a1053818c4 # Parent 2e546a5175ddd30911d541497b7ab10c96d077dc DOM - в разработке Testing - по мелочи Property - изменен механизм выбора имплементора diff -r 2e546a5175dd -r e59f44f75f20 Lib/IMPL/Class/PropertyInfo.pm --- a/Lib/IMPL/Class/PropertyInfo.pm Tue Aug 11 17:45:52 2009 +0400 +++ b/Lib/IMPL/Class/PropertyInfo.pm Wed Aug 12 17:36:07 2009 +0400 @@ -6,33 +6,48 @@ __PACKAGE__->mk_accessors(qw(Type Mutators canGet canSet)); __PACKAGE__->PassThroughArgs; -our @Implementors = ( ['IMPL::Object' => 'IMPL::Class::Property::Direct'] ); - my %LoadedModules; sub CTOR { my $this = shift; - my $implementor = $this->Implementor($this->SelectImplementor()); - if (my $class = ref $implementor ? undef : $implementor) { - if (not $LoadedModules{$class}) { - (my $package = $class.'.pm') =~ s/::/\//g; - require $package; - $LoadedModules{$class} = 1; + $this->Mutators(0) unless defined $this->Mutators; +} + +sub Implementor { + my $this = shift; + + my $implementor; + + if (@_) { + $this->SUPER::Implementor(@_); + } else { + my $implementor = $this->SUPER::Implementor; + return $implementor if $implementor; + + $implementor = $this->SelectImplementor(); + + if (my $class = ref $implementor ? undef : $implementor) { + if (not $LoadedModules{$class}) { + (my $package = $class.'.pm') =~ s/::/\//g; + require $package; + $LoadedModules{$class} = 1; + } } + + $this->Implementor($implementor); + return $implementor; } - $this->Mutators(0) unless defined $this->Mutators; } sub SelectImplementor { my ($this) = @_; - foreach my $item (@Implementors) { - return $item->[1] if $this->Class->isa($item->[0]); + if ($this->Class->can('_PropertyImplementor')) { + return $this->Class->_PropertyImplementor; } - die new IMPL::Exception('Can\'t find a property implementor for the specified class',$this->Class); } -1; +1; \ No newline at end of file diff -r 2e546a5175dd -r e59f44f75f20 Lib/IMPL/DOM/FixedNode.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/DOM/FixedNode.pm Wed Aug 12 17:36:07 2009 +0400 @@ -0,0 +1,12 @@ +package IMPL::DOM::FixedNode; +use strict; +use warnings; + +use base qw(IMPL::DOM::Node); + +sub Validate { + +} + + +1; diff -r 2e546a5175dd -r e59f44f75f20 Lib/IMPL/DOM/Node.pm --- a/Lib/IMPL/DOM/Node.pm Tue Aug 11 17:45:52 2009 +0400 +++ b/Lib/IMPL/DOM/Node.pm Wed Aug 12 17:36:07 2009 +0400 @@ -4,6 +4,7 @@ use base qw(IMPL::Object IMPL::Object::Serializable IMPL::Object::Autofill); +use IMPL::Object::List; use IMPL::Class::Property; use IMPL::Class::Property::Direct; use Scalar::Util qw(weaken); @@ -13,12 +14,12 @@ __PACKAGE__->PassThroughArgs; BEGIN { - public property nodeName => prop_get | owner_set; - public property isComplex => prop_get | owner_set; - public property nodeValue => prop_get | owner_set; - public property childNodes => prop_get | owner_set| prop_list; - public property parentNode => prop_get | owner_set; - private property _propertyMap => prop_all; + public _direct property nodeName => prop_get | owner_set; + public _direct property isComplex => { get => \&_getIsComplex } ; + public _direct property nodeValue => prop_all; + public _direct property childNodes => { get => \&_getChildNodes }; + public _direct property parentNode => prop_get ; + private _direct property _propertyMap => prop_all; } sub CTOR { @@ -30,26 +31,71 @@ sub insertNode { my ($this,$node,$pos) = @_; + + die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; + + $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); + + $this->childNodes->InsertAt($pos,$node); + + $node->_setParent( $this ); + + return $node; +} + +sub _getChildNodes { + my ($this) = @_; + + $this->{$childNodes} = new IMPL::Object::List() unless $this->{$childNodes}; + $this->{$childNodes}; } sub removeNode { my ($this,$node) = @_; + + if ($this == $node->{$parentNode}) { + $this->childNodes->RemoveItem($node); + $node->{$parentNode} = undef; + return $this; + } else { + die new IMPL::InvalidOperationException("The specified node isn't belong to this node"); + } } sub removeAt { my ($this,$pos) = @_; + + if ( my $node = $this->childNodes->RemoveAt($pos) ) { + $node->{$parentNode} = undef; + return $node; + } else { + return undef; + } } sub selectNodes { my ($this,$name) = @_; + + my @result = grep $_->nodeName eq $name, @{$this->childNodes}; + + return wantarray ? @result : \@result; } -sub setParent { +sub _getIsComplex { + $_[0]->childNodes->Count ? 1 : 0; +} + +sub _setParent { my ($this,$parentNode) = @_; + + $this->{$parentNode} = $parentNode; + weaken($this->{$parentNode}); } sub text { my ($this) = @_; + + join '', $this->nodeValue, map $_->nodeValue, @{$this->childNodes}; } sub Property { diff -r 2e546a5175dd -r e59f44f75f20 Lib/IMPL/Object.pm --- a/Lib/IMPL/Object.pm Tue Aug 11 17:45:52 2009 +0400 +++ b/Lib/IMPL/Object.pm Wed Aug 12 17:36:07 2009 +0400 @@ -15,6 +15,10 @@ $self; } +sub _PropertyImplementor { + 'IMPL::Class::Property::Direct' +} + =pod =h1 SYNOPSIS diff -r 2e546a5175dd -r e59f44f75f20 Lib/IMPL/Object/Accessor.pm --- a/Lib/IMPL/Object/Accessor.pm Tue Aug 11 17:45:52 2009 +0400 +++ b/Lib/IMPL/Object/Accessor.pm Wed Aug 12 17:36:07 2009 +0400 @@ -1,6 +1,6 @@ package IMPL::Object::Accessor; use strict; -use base qw(IMPL::Object Class::Accessor IMPL::Class::Meta); +use base qw(IMPL::Object::Abstract Class::Accessor IMPL::Class::Meta); sub new { my $class = shift; diff -r 2e546a5175dd -r e59f44f75f20 Lib/IMPL/Object/List.pm --- a/Lib/IMPL/Object/List.pm Tue Aug 11 17:45:52 2009 +0400 +++ b/Lib/IMPL/Object/List.pm Wed Aug 12 17:36:07 2009 +0400 @@ -6,7 +6,7 @@ use IMPL::Exception; sub as_list { - return $_[0]; + return wantarray ? @{$_[0]} : $_[0]; } sub CTOR { @@ -52,4 +52,21 @@ return splice @$this,$index,$count; } +sub RemoveItem { + my ($this,$item) = @_; + + @$this = grep $_ != $item, @$this; + + return $this; +} + +sub RemoveItemStr { + my ($this,$item) = @_; + + @$this = grep $_ ne $item, @$this; + + return $this; +} + + 1; diff -r 2e546a5175dd -r e59f44f75f20 Lib/IMPL/Object/Verify.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Object/Verify.pm Wed Aug 12 17:36:07 2009 +0400 @@ -0,0 +1,7 @@ +package IMPL::Object::Verify; +use strict; +use warnings; + + + +1; diff -r 2e546a5175dd -r e59f44f75f20 _test/run_tests.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/run_tests.pl Wed Aug 12 17:36:07 2009 +0400 @@ -0,0 +1,21 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use IMPL::Test::HarnessRunner; +use IMPL::Test::Straps; + +my $runner = new IMPL::Test::HarnessRunner( + Strap => new IMPL::Test::Straps () +); + +$runner->Strap->Executors( + { + Re => '.*', + Executor => $runner->Strap + } +); + +$runner->RunTests(<*.t>); + +1; diff -r 2e546a5175dd -r e59f44f75f20 impl.kpf --- a/impl.kpf Tue Aug 11 17:45:52 2009 +0400 +++ b/impl.kpf Wed Aug 12 17:36:07 2009 +0400 @@ -1,6 +1,8 @@ + + @@ -170,6 +172,32 @@ default + + + + + + 9011 + + + _test/run_tests.pl + + Perl + + + + application/x-www-form-urlencoded + GET + 1 + 0 + 0 + + + enabled + + + default +