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">