# HG changeset patch
# User Sergey
# Date 1258724888 -10800
# Node ID 1828103371d01950f8bbf620d14c7fffa909d3d3
# Parent f25d021780b35d6fe83f320ca96b63d3be7df5f9
DOM in works
diff -r f25d021780b3 -r 1828103371d0 Lib/IMPL/DOM/Document.pm
--- 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__
diff -r f25d021780b3 -r 1828103371d0 Lib/IMPL/DOM/Navigator.pm
--- 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;
}
diff -r f25d021780b3 -r 1828103371d0 Lib/IMPL/DOM/Navigator/SchemaNavigator.pm
--- 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
}
#}
}
diff -r f25d021780b3 -r 1828103371d0 Lib/IMPL/DOM/Navigator/SimpleBuilder.pm
--- /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;
diff -r f25d021780b3 -r 1828103371d0 Lib/IMPL/DOM/Node.pm
--- 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}};
}
}
diff -r f25d021780b3 -r 1828103371d0 _test/Test/DOM/Builder.pm
--- 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;
diff -r f25d021780b3 -r 1828103371d0 _test/Test/DOM/Navigator.pm
--- 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";
diff -r f25d021780b3 -r 1828103371d0 _test/any.pl
--- 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
diff -r f25d021780b3 -r 1828103371d0 impl.kpf
--- 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 @@
default
+
+
+
+
+
+ 9011
+
+
+ Lib/IMPL/DOM/Navigator/SimpleBuilder.pm
+
+ Perl
+
+
+
+ application/x-www-form-urlencoded
+ GET
+ 1
+ 0
+ 0
+
+
+ enabled
+
+
+ default
+