changeset 36:1828103371d0

DOM in works
author Sergey
date Fri, 20 Nov 2009 16:48:08 +0300
parents f25d021780b3
children c2e7f7c96bcd
files Lib/IMPL/DOM/Document.pm Lib/IMPL/DOM/Navigator.pm Lib/IMPL/DOM/Navigator/SchemaNavigator.pm Lib/IMPL/DOM/Navigator/SimpleBuilder.pm Lib/IMPL/DOM/Node.pm _test/Test/DOM/Builder.pm _test/Test/DOM/Navigator.pm _test/any.pl impl.kpf
diffstat 9 files changed, 179 insertions(+), 34 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/DOM/Document.pm	Tue Nov 17 17:46:24 2009 +0300
+++ b/Lib/IMPL/DOM/Document.pm	Fri Nov 20 16:48:08 2009 +0300
@@ -19,6 +19,13 @@
     );
 }
 
+{
+    my $empty;
+    sub Empty() {
+        return $empty ? $empty : $empty = __PACKAGE__->new(nodeName => 'Empty');
+    }
+}
+
 1;
 __END__
 
--- a/Lib/IMPL/DOM/Navigator.pm	Tue Nov 17 17:46:24 2009 +0300
+++ b/Lib/IMPL/DOM/Navigator.pm	Fri Nov 20 16:48:08 2009 +0300
@@ -20,6 +20,16 @@
     $this->{$_state} = { alternatives => [ $CurrentNode ], current => 0 };
 }
 
+sub _initNavigator {
+    my ($this,$CurrentNode) = @_;
+    
+    die IMPL::InvalidArgumentException("A starting node is a required paramater") unless $CurrentNode;
+    
+    $this->{$_state} = { alternatives => [ $CurrentNode ], current => 0 };
+    delete $this->{$_path};
+    delete $this->{$_savedstates};
+}
+
 sub _getCurrent {
     $_[0]->{$_state}{alternatives}[$_[0]->{$_state}{current}]
 }
@@ -29,14 +39,16 @@
     
     return unless @path;
     
+    my $node;
+    
     foreach my $query (@path) {
         if (my $current = $this->Current) {
             
-            my @alternatives = $this->Current->selectNodes($query);
+            my @alternatives = $current->selectNodes($query);
             
             unless (@alternatives) {
-                $this->advanceNavigator or return undef;
-                @alternatives = $this->Current->selectNodes($query);
+                $current = $this->advanceNavigator or return undef;
+                @alternatives = $current->selectNodes($query);
             }
             
             push @{$this->{$_path}},$this->{$_state};
@@ -44,13 +56,15 @@
                 alternatives => \@alternatives,
                 current => 0,
                 query => $query
-            }
+            };
+            
+            $node = $alternatives[0];
         } else {
             return undef;
         }
     }
     
-    return $this->Current;
+    $node;
 }
 
 sub selectNodes {
@@ -80,7 +94,7 @@
         current => 0
     };
     
-    return $this->Current;
+    $nodeSet[0];
 }
 
 sub fetch {
@@ -100,16 +114,16 @@
         if ( exists $this->{$_state}{query} ) {
             my $query = $this->{$_state}{query};
   
-            $this->Back or return 0; # that meams the end of the history
+            $this->Back or return undef; # that meams the end of the history
 
             undef while ( $this->advanceNavigator and not $this->Navigate($query));
 
-            return $this->Current ? 1 : 0;
+            return $this->Current;
         }
-        return 0;
+        return undef;
     }
     
-    return 1;
+    return $this->Current;
 }
 
 sub doeach {
@@ -121,22 +135,23 @@
             $_ = $this->{$_state}{alternatives}[$i];
             $code->();
         }
-         $this->{$_state}{current} = @{$this->{$_state}{alternatives}};
+        $this->{$_state}{current} = @{$this->{$_state}{alternatives}};
     } while ($this->advanceNavigator);
 }
 
 sub Back {
     my ($this,$steps) = @_;
-    
-    $steps ||= 1;
-    
     if ($this->{$_path} and @{$this->{$_path}}) {
-        
-        $steps = @{$this->{$_path}} - 1 if $steps >= @{$this->{$_path}};
-        
-        ($this->{$_state}) = splice @{$this->{$_path}},-$steps;
-        
-        $this->Current;
+        if ( (not $steps) || $steps == 1) {
+            $this->{$_state} = pop @{$this->{$_path}};
+        } else {
+            $steps ||= 1;
+            
+            $steps = @{$this->{$_path}} - 1 if $steps >= @{$this->{$_path}};
+            
+            $this->{$_state} = (splice @{$this->{$_path}},-$steps)[0];
+        }
+        $this->Current if defined wantarray;
     } else {
         return undef;
     }
--- a/Lib/IMPL/DOM/Navigator/SchemaNavigator.pm	Tue Nov 17 17:46:24 2009 +0300
+++ b/Lib/IMPL/DOM/Navigator/SchemaNavigator.pm	Fri Nov 20 16:48:08 2009 +0300
@@ -82,7 +82,7 @@
             # return found node schema
             return $node;
         } else {
-            die; # abort navigation
+            return undef; # abort navigation
         }
     #}
 }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/Navigator/SimpleBuilder.pm	Fri Nov 20 16:48:08 2009 +0300
@@ -0,0 +1,37 @@
+package IMPL::DOM::Navigator::SimpleBuilder;
+use strict;
+use warnings;
+
+use base qw(IMPL::DOM::Navigator);
+
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+
+require IMPL::DOM::Navigator::SchemaNavigator;
+use IMPL::DOM::Document;
+
+BEGIN {
+    public _direct property Document => prop_get | owner_set;
+}
+
+our %CTOR = (
+    'IMPL::DOM::Navigator' => sub { IMPL::DOM::Document::Empty; }
+);
+
+sub NavigateCreate {
+    my ($this,$nodeName,%props) = @_;
+    
+    my $node;
+    if (! $this->{$Document}) {
+        $node = $this->{$Document} = IMPL::DOM::Document->new(nodeName => $nodeName,%props);
+        $this->_initNavigator($node);
+    } else {
+        die new IMPL::InvalidOperationException('Can\t create a second top level element') unless $this->Current;
+        $node = $this->{$Document}->Create($nodeName,'IMPL::DOM::Node',\%props);
+        $this->Current->appendChild($node);
+        $this->internalNavigateNodeSet($node);
+    }
+    return $node;
+}
+
+1;
--- a/Lib/IMPL/DOM/Node.pm	Tue Nov 17 17:46:24 2009 +0300
+++ b/Lib/IMPL/DOM/Node.pm	Fri Nov 20 16:48:08 2009 +0300
@@ -209,15 +209,13 @@
         if ($this->{$rootNode} ? $this->{$rootNode} != $newRoot : 1 ) {
             $this->{$rootNode} = $newRoot;
             weaken($this->{$rootNode});
-            if ($this->{$childNodes}) {
-                $_->_updateRootRefs foreach @{$this->{$childNodes}};
-            }
         }
     } elsif($this->{$rootNode}) {
         delete $this->{$rootNode};
-        if ($this->{$childNodes}) {
-            $_->_updateRootRefs foreach @{$this->{$childNodes}};
-        }
+    }
+    
+    if ($this->{$childNodes}) {
+        $_->_updateRootRefs foreach @{$this->{$childNodes}};
     }
 }
 
--- a/_test/Test/DOM/Builder.pm	Tue Nov 17 17:46:24 2009 +0300
+++ b/_test/Test/DOM/Builder.pm	Fri Nov 20 16:48:08 2009 +0300
@@ -10,6 +10,7 @@
 
 require IMPL::DOM::Schema;
 require IMPL::DOM::Navigator::Builder;
+require IMPL::DOM::Navigator::SimpleBuilder;
 require IMPL::DOM::Document;
 
 BEGIN {
@@ -84,5 +85,46 @@
     return 1;
 };
 
+test BuildSimpleDocument => sub {
+    my ($this) = @_;
+    
+    my $builder = IMPL::DOM::Navigator::SimpleBuilder->new();
+    
+    use Time::HiRes qw(gettimeofday tv_interval);
+    
+    my $t = [gettimeofday];
+    
+    $builder->NavigateCreate('personInfo', version => '1');
+        $builder->NavigateCreate('firstName')->nodeValue('Nemo');
+        $builder->Back();
+        $builder->NavigateCreate('lastName')->nodeValue('Nobel');
+        $builder->Back();
+        $builder->NavigateCreate('lastName')->nodeValue('Gardum');
+        $builder->Back();
+        for(1..100) {
+            $builder->NavigateCreate('address', local => 1);
+                $builder->NavigateCreate('street')->nodeValue('Hellroad');
+                $builder->Back();
+                $builder->NavigateCreate('line')->nodeValue($_);
+                $builder->Back();
+            $builder->Back();
+        }
+    $builder->Back();
+    
+    print "Build: ",tv_interval($t,[gettimeofday]),"\n";
+    $t = [gettimeofday];
+    print $_->Message,"\n" foreach $this->schemaDoc->Validate($builder->Document);
+    print "Validate: ",tv_interval($t,[gettimeofday]),"\n";
+    
+    $t = [gettimeofday];
+    for (1...100) {
+        my $node = new IMPL::DOM::Node(nodeName => 'dummy', foo => 'bar');
+        $node->nodeValue('dummy content');
+    }
+    print "Create a set of nodes: ",tv_interval($t,[gettimeofday]),"\n";
+    
+    return 1;
+};
+
 
 1;
--- a/_test/Test/DOM/Navigator.pm	Tue Nov 17 17:46:24 2009 +0300
+++ b/_test/Test/DOM/Navigator.pm	Fri Nov 20 16:48:08 2009 +0300
@@ -145,7 +145,7 @@
     $navi->NavigateName('Node') or failed "Failed to navigate to a simple node";
     $navi->restoreState;
     
-    failed "Can't navigate from simple node" if $navi->NavigateName('Property');
+    failed "Can't navigate from simple node" if $navi->dosafe(sub { $navi->NavigateName('Property') || die } );
     
     $navi->NavigateName('ComplexType') or failed "Failed to navigate to a complex node";
     $navi->NavigateName('NodeSet') or failed "Failed to navigate to NodeSet";
--- a/_test/any.pl	Tue Nov 17 17:46:24 2009 +0300
+++ b/_test/any.pl	Fri Nov 20 16:48:08 2009 +0300
@@ -1,10 +1,30 @@
 #!/usr/bin/perl -w
 use strict;
+use lib '..\Lib';
 
-my @data = (1,2,3,4);
+require IMPL::DOM::Navigator::SimpleBuilder;
 
-sub func {
-    return \@data;
-}
-
-print "$_\n" and $data[3]=0 foreach @{func()};
+my $builder = IMPL::DOM::Navigator::SimpleBuilder->new();
+    
+    use Time::HiRes qw(gettimeofday tv_interval);
+    
+    my $t = [gettimeofday];
+    
+    $builder->NavigateCreate('personInfo', version => '1');
+        $builder->NavigateCreate('firstName')->nodeValue('Nemo');
+        $builder->Back();
+        $builder->NavigateCreate('lastName')->nodeValue('Nobel');
+        $builder->Back();
+        $builder->NavigateCreate('lastName')->nodeValue('Gardum');
+        $builder->Back();
+        for(1..10000) {
+            $builder->NavigateCreate('address', local => 1);
+                $builder->NavigateCreate('street')->nodeValue('Hellroad');
+                $builder->Back();
+                $builder->NavigateCreate('line')->nodeValue($_);
+                $builder->Back();
+            $builder->Back();
+        }
+    $builder->Back();
+    
+    print "Build: ",tv_interval($t,[gettimeofday]),"\n";
\ No newline at end of file
--- a/impl.kpf	Tue Nov 17 17:46:24 2009 +0300
+++ b/impl.kpf	Fri Nov 20 16:48:08 2009 +0300
@@ -144,6 +144,32 @@
 </preference-set>
   <string id="lastInvocation">default</string>
 </preference-set>
+<preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/Lib/IMPL/DOM/Navigator/SimpleBuilder.pm">
+<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">Lib/IMPL/DOM/Navigator/SimpleBuilder.pm</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="66c7d414-175f-45b6-92fe-dbda51c64843/Lib/IMPL/DOM/Schema.pm">
 <preference-set id="Invocations">
 <preference-set id="default">