# HG changeset patch
# User Sergey
# Date 1251918674 -14400
# Node ID bb8d67f811ea2e29e846f557f6d9063744050586
# Parent  955b2324c1bf1bb73f1609a1a7dbdbc0f3345ee0# Parent  75980091813b44869c4544532b493fd03a83677f
merge heads

diff -r 955b2324c1bf -r bb8d67f811ea Lib/IMPL/DOM/Navigator.pm
--- a/Lib/IMPL/DOM/Navigator.pm	Mon Aug 31 01:37:43 2009 +0400
+++ b/Lib/IMPL/DOM/Navigator.pm	Wed Sep 02 23:11:14 2009 +0400
@@ -3,7 +3,77 @@
 use warnings;
 
 use base qw(IMPL::Object);
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+BEGIN {
+    public _direct property Path => prop_get | owner_set;
+    public _direct property Current => prop_get | owner_set;
+}
 
+sub CTOR {
+    my ($this,$CurrentNode) = @_;
+    
+    $this->{$Current} = $CurrentNode or die IMPL::InvalidArgumentException("A starting node is a required paramater");
+}
 
+sub Navigate {
+    my ($this,$query) = @_;
+    
+    if ( my ($newNode) = $this->{$Current}->selectNodes($query) ) {
+        push @{$this->{$Path}}, $this->{$Current};
+        return $this->{$Current} = $newNode;
+    } else {
+        return undef;
+    }
+}
+
+sub Back {
+    my ($this) = @_;
+    
+    if ( my $newNode = $this->{$Path} ? pop @{$this->{$Path}} : undef ) {
+        return $this->{$Current} = $newNode;
+    } else {
+        return undef;
+    }
+}
+
+sub PathToString {
+    my $this = shift;
+    
+    join('/',map $_->nodeName, $this->{$Path} ? (@{$this->{$Path}}, $this->{$Current}) : $this->{$Current});
+}
 
 1;
+
+__END__
+=pod
+
+=head1 DESCRIPTION
+
+Объект для хождения по дереву DOM объектов.
+
+=head1 METHODS
+
+=over
+
+=item C<$obj->new($nodeStart)>
+
+Создает объект навигатора с указанной начальной позицией.
+
+=item C<$obj->Navigate($query)>
+
+Перейти в новый узел используя запрос C<$query>. На данный момент запросом может
+быть только имя узла и будет взят только первый узел. Если по запросу ничего не
+найдено, переход не будет осуществлен.
+
+Возвращает либо новый узел в который перешли, либо C<undef>.
+
+=item C<$obj->Back()>
+
+Возвращается в предыдущий узел, если таковой есть.
+
+Возвращает либо узел в который перешли, либо C<undef>.
+
+=back
+
+=cut
\ No newline at end of file
diff -r 955b2324c1bf -r bb8d67f811ea Lib/IMPL/DOM/Navigator/Builder.pm
--- a/Lib/IMPL/DOM/Navigator/Builder.pm	Mon Aug 31 01:37:43 2009 +0400
+++ b/Lib/IMPL/DOM/Navigator/Builder.pm	Wed Sep 02 23:11:14 2009 +0400
@@ -3,36 +3,32 @@
 use warnings;
 
 use base qw(IMPL::DOM::Navigator);
-
 use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
 
 BEGIN {
-    public property SchemaNavigator => prop_get | owner_set;
+    protected _direct property _navigatorSchema => prop_all;
+    public _direct property Document => prop_get | owner_set;
+}
+
+__PACKAGE__->PassThroughArgs;
+
+sub CTOR {
+    my ($this,$domDocument,$schema) = @_;
+    
+    $this->{$Document} = $domDocument;
+    $this->{$_navigatorSchema} = new IMPL::DOM::Navigator($schema);
+}
+
+sub NavigateCreate {
+    my ($this,$nodeName,%props) = @_;
+    
+    if ( my $nodeSchema = $this->{$_navigatorSchema}->Navigate($nodeName) ) {
+        
+        
+    } else {
+        die new IMPL::InvalidOperationException("Requested elemnt not found in the schema");
+    }
 }
 
 1;
-
-=pod
-
-=head1 SYNOPSIS
-
-my $nav = new IMPL::DOM::Navigator::Builder(Schema => $mySchema);
-
-# set position to root
-$nav->InitRoot();
-
-# go to node 'Person' and create one if not exists
-$nav->NavigateAuto("Person");
-
-# set some node properties
-$nav->nodeCurrent->Name("Smith");
-$nav->nodeCurrent->Age("20");
-
-# navigate to node 'Address' and create one if not exists
-$nav->NavigateAuto("Address");
-
-=head1 DESCRIPTION
-
-Навигатор, который позволяет формировать документ в соответствии со схемой
-
-=cut
\ No newline at end of file
diff -r 955b2324c1bf -r bb8d67f811ea Lib/IMPL/DOM/Node.pm
--- a/Lib/IMPL/DOM/Node.pm	Mon Aug 31 01:37:43 2009 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Wed Sep 02 23:11:14 2009 +0400
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use base qw(IMPL::Object IMPL::Object::Serializable IMPL::Object::Autofill);
+use base qw(IMPL::Object);
 
 use IMPL::Object::List;
 use IMPL::Class::Property;
@@ -11,8 +11,6 @@
 
 use IMPL::Exception;
 
-__PACKAGE__->PassThroughArgs;
-
 BEGIN {
     public _direct property nodeName => prop_get | owner_set;
     public _direct property isComplex => { get => \&_getIsComplex } ;
@@ -23,9 +21,9 @@
 }
 
 sub CTOR {
-    my ($this,$name) = @_;
+    my ($this,%args) = @_;
     
-    $this->nodeName($name) or die new IMPL::InvalidArgumentException("A name is required");
+    $this->nodeName($args{nodeName}) or die new IMPL::InvalidArgumentException("A name is required");
 }
 
 sub insertNode {
@@ -112,9 +110,9 @@
 }
 
 sub _setParent {
-    my ($this,$parentNode) = @_;
+    my ($this,$node) = @_;
     
-    $this->{$parentNode} = $parentNode;
+    $this->{$parentNode} = $node;
     weaken($this->{$parentNode});
 }
 
diff -r 955b2324c1bf -r bb8d67f811ea Lib/IMPL/DOM/XMLReader.pm
diff -r 955b2324c1bf -r bb8d67f811ea Lib/IMPL/Object/List.pm
--- a/Lib/IMPL/Object/List.pm	Mon Aug 31 01:37:43 2009 +0400
+++ b/Lib/IMPL/Object/List.pm	Wed Sep 02 23:11:14 2009 +0400
@@ -41,7 +41,7 @@
 sub InsertAt {
     my ($this,$index,@val) = @_;
     
-    splice @$this,$index,0,@val;
+    splice @$this,($index||0),0,@val;
 }
 
 sub RemoveAt {
diff -r 955b2324c1bf -r bb8d67f811ea _test/DOM.t
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/DOM.t	Wed Sep 02 23:11:14 2009 +0400
@@ -0,0 +1,15 @@
+#!/usr/bin/perl -w
+use strict;
+use lib '../Lib';
+use lib '.';
+
+use IMPL::Test::Plan;
+use IMPL::Test::TAPListener;
+
+my $plan = new IMPL::Test::Plan qw(
+    Test::DOM::Navigator
+);
+
+$plan->AddListener(new IMPL::Test::TAPListener);
+$plan->Prepare();
+$plan->Run();
\ No newline at end of file
diff -r 955b2324c1bf -r bb8d67f811ea _test/Test/DOM/Navigator.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/DOM/Navigator.pm	Wed Sep 02 23:11:14 2009 +0400
@@ -0,0 +1,71 @@
+package Test::DOM::Navigator;
+use base qw(IMPL::Test::Unit);
+
+__PACKAGE__->PassThroughArgs;
+
+use IMPL::Test qw(test failed);
+use IMPL::DOM::Navigator;
+use IMPL::DOM::Node;
+
+test Creation => sub {
+    my ($this) = @_;
+    
+    my $doc = new IMPL::DOM::Node(nodeName => 'root');
+    
+    my $obj = new IMPL::DOM::Navigator($doc) or failed "Failed to create instance" ;
+};
+
+test Navigate => sub {
+    my $doc = new IMPL::DOM::Node(nodeName => 'root');
+    my $child = $doc->insertNode(
+        new IMPL::DOM::Node(
+            nodeName => 'Child'
+        )
+    );
+    
+    my $navi = new IMPL::DOM::Navigator($doc);
+    my $navresult = $navi->Navigate("Child");
+    
+    failed ("Navigate retuned unexpected result", "Recieved: $navresult", "Expected: $child") if $child != $navresult;
+    my $curr = $navi->Current;
+    failed ("Current node has a wrong value","Current: $curr","Expected: $child") if $child != $curr;
+};
+
+test PathToString => sub {
+    my $doc = new IMPL::DOM::Node(nodeName => 'root');
+    my $child = $doc->insertNode(
+        new IMPL::DOM::Node(
+            nodeName => 'Child'
+        )
+    );
+    
+    my $navi = new IMPL::DOM::Navigator($doc);
+    $navi->Navigate("Child");
+    
+    my $expected = "root/Child";
+    my $res = $navi->PathToString;
+    failed("Unexpected PathToString result","Recieved: $res","Expected: $expected") if $res ne $expected;
+};
+
+test Back => sub {
+    my $doc = new IMPL::DOM::Node(nodeName => 'root');
+    my $child = $doc->insertNode(
+        new IMPL::DOM::Node(
+            nodeName => 'Child'
+        )
+    );
+    
+    my $navi = new IMPL::DOM::Navigator($doc);
+    $navi->Navigate("Child");
+    my $navresult = $navi->Back;
+    
+    failed ("Back() retuned unexpected result", "Recieved: $navresult", "Expected: $doc") if $doc != $navresult;
+    my $curr = $navi->Current;
+    failed ("Current node has a wrong value","Current: $curr","Expected: $doc") if $doc != $curr;
+};
+
+
+
+
+
+1;
diff -r 955b2324c1bf -r bb8d67f811ea _test/any.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/any.pl	Wed Sep 02 23:11:14 2009 +0400
@@ -0,0 +1,19 @@
+#!/usr/bin/perl -w
+#use strict;
+
+use HTML::Element;
+$a = HTML::Element->new('a', href => 'http://www.perl.com/');
+$a->push_content("The Perl Homepage");
+
+$tag = $a->tag;
+print "$tag starts out as:",  $a->starttag, "\n";
+print "$tag ends as:",  $a->endtag, "\n";
+print "$tag\'s href attribute is: ", $a->attr('href'), "\n";
+
+$links_r = $a->extract_links();
+print "Hey, I found ", scalar(@$links_r), " links.\n";
+
+print "And that, as HTML, is: ", $a->as_HTML, "\n";
+$a = $a->delete;
+
+
diff -r 955b2324c1bf -r bb8d67f811ea _test/any.t
--- a/_test/any.t	Mon Aug 31 01:37:43 2009 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,19 +0,0 @@
-#!/usr/bin/perl -w
-#use strict;
-
-use HTML::Element;
-$a = HTML::Element->new('a', href => 'http://www.perl.com/');
-$a->push_content("The Perl Homepage");
-
-$tag = $a->tag;
-print "$tag starts out as:",  $a->starttag, "\n";
-print "$tag ends as:",  $a->endtag, "\n";
-print "$tag\'s href attribute is: ", $a->attr('href'), "\n";
-
-$links_r = $a->extract_links();
-print "Hey, I found ", scalar(@$links_r), " links.\n";
-
-print "And that, as HTML, is: ", $a->as_HTML, "\n";
-$a = $a->delete;
-
-
diff -r 955b2324c1bf -r bb8d67f811ea impl.kpf
--- a/impl.kpf	Mon Aug 31 01:37:43 2009 +0400
+++ b/impl.kpf	Wed Sep 02 23:11:14 2009 +0400
@@ -222,7 +222,7 @@
 </preference-set>
   <string id="lastInvocation">default</string>
 </preference-set>
-<preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/Web.t">
+<preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/DOM.t">
 <preference-set id="Invocations">
 <preference-set id="default">
   <string id="cookieparams"></string>
@@ -230,7 +230,7 @@
   <long id="debugger.io-port">9011</long>
   <string id="documentRoot"></string>
   <string id="executable-params"></string>
-  <string relative="path" id="filename">_test/Web.t</string>
+  <string relative="path" id="filename">_test/DOM.t</string>
   <string id="getparams"></string>
   <string id="language">Perl</string>
   <string id="mpostparams"></string>
@@ -248,7 +248,7 @@
 </preference-set>
   <string id="lastInvocation">default</string>
 </preference-set>
-<preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/any.t">
+<preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/_test/Web.t">
 <preference-set id="Invocations">
 <preference-set id="default">
   <string id="cookieparams"></string>
@@ -256,7 +256,7 @@
   <long id="debugger.io-port">9011</long>
   <string id="documentRoot"></string>
   <string id="executable-params"></string>
-  <string relative="path" id="filename">_test/any.t</string>
+  <string relative="path" id="filename">_test/Web.t</string>
   <string id="getparams"></string>
   <string id="language">Perl</string>
   <string id="mpostparams"></string>