Mercurial > pub > Impl
changeset 4:e59f44f75f20
DOM - в разработке
Testing - по мелочи
Property - изменен механизм выбора имплементора
author | Sergey |
---|---|
date | Wed, 12 Aug 2009 17:36:07 +0400 |
parents | 2e546a5175dd |
children | efa7db58abae |
files | Lib/IMPL/Class/PropertyInfo.pm Lib/IMPL/DOM/FixedNode.pm Lib/IMPL/DOM/Node.pm Lib/IMPL/Object.pm Lib/IMPL/Object/Accessor.pm Lib/IMPL/Object/List.pm Lib/IMPL/Object/Verify.pm _test/run_tests.pl impl.kpf |
diffstat | 9 files changed, 172 insertions(+), 22 deletions(-) [+] |
line wrap: on
line diff
--- 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
--- /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;
--- 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 {
--- 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
--- 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;
--- 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;
--- /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;
--- /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;
--- 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 @@ <?xml version="1.0" encoding="UTF-8"?> <!-- Komodo Project File - DO NOT EDIT --> <project id="66c7d414-175f-45b6-92fe-dbda51c64843" kpf_version="4" name="impl.kpf"> +<file id="c255e877-43b0-4625-a9f2-fbf8e65179c8" idref="66c7d414-175f-45b6-92fe-dbda51c64843/Lib/IMPL/DOM" name="Node.pm" url="Lib/IMPL/DOM/Node.pm"> +</file> <file id="91cab186-0c9b-4ed6-98e8-3de5c132e296" idref="66c7d414-175f-45b6-92fe-dbda51c64843/Lib/IMPL/Object" name="Node.pm" url="Lib/IMPL/DOM/Node.pm"> </file> <preference-set idref="155f1fd9-8a20-46fe-90d5-8fbe879632d8"> @@ -170,6 +172,32 @@ </preference-set> <string id="lastInvocation">default</string> </preference-set> +<preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/run_tests.pl"> +<preference-set id="Invocations"> +<preference-set id="default"> + <string id="cookieparams"></string> + <string id="cwd"></string> + <long id="debugger.io-port">9011</long> + <string id="documentRoot"></string> + <string id="executable-params"></string> + <string relative="path" id="filename">_test/run_tests.pl</string> + <string id="getparams"></string> + <string id="language">Perl</string> + <string id="mpostparams"></string> + <string id="params"></string> + <string id="postparams"></string> + <string id="posttype">application/x-www-form-urlencoded</string> + <string id="request-method">GET</string> + <boolean id="show-dialog">1</boolean> + <boolean id="sim-cgi">0</boolean> + <boolean id="use-console">0</boolean> + <string id="userCGIEnvironment"></string> + <string id="userEnvironment"></string> + <string id="warnings">enabled</string> +</preference-set> +</preference-set> + <string id="lastInvocation">default</string> +</preference-set> <preference-set idref="7e7fa5c6-0123-4570-8540-b1366b09b7dd"> <preference-set id="Invocations"> <preference-set id="default">