changeset 11:75980091813b

DOM и навигация
author Sergey
date Wed, 02 Sep 2009 17:47:44 +0400
parents 63f6653b094e
children bb8d67f811ea
files Lib/IMPL/DOM/Navigator.pm Lib/IMPL/DOM/Navigator/Builder.pm Lib/IMPL/DOM/Node.pm Lib/IMPL/DOM/XMLReader.pm Lib/IMPL/Object/List.pm _test/DOM.t _test/Test/DOM/Navigator.pm _test/any.pl _test/any.t impl.kpf
diffstat 10 files changed, 221 insertions(+), 35 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/DOM/Navigator.pm	Fri Aug 28 16:26:20 2009 +0400
+++ b/Lib/IMPL/DOM/Navigator.pm	Wed Sep 02 17:47:44 2009 +0400
@@ -2,10 +2,78 @@
 use strict;
 use warnings;
 
-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT_OK = qw();
+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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/Navigator/Builder.pm	Wed Sep 02 17:47:44 2009 +0400
@@ -0,0 +1,34 @@
+package IMPL::DOM::Navigator::Builder;
+use strict;
+use warnings;
+
+use base qw(IMPL::DOM::Navigator);
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+
+BEGIN {
+    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;
--- a/Lib/IMPL/DOM/Node.pm	Fri Aug 28 16:26:20 2009 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Wed Sep 02 17:47:44 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});
 }
 
--- a/Lib/IMPL/DOM/XMLReader.pm	Fri Aug 28 16:26:20 2009 +0400
+++ b/Lib/IMPL/DOM/XMLReader.pm	Wed Sep 02 17:47:44 2009 +0400
@@ -29,7 +29,7 @@
 sub OnBegin {
     my ($this,$element,%attrs) = @_;
     
-    $this->{$_current} = $this->Navigator->CreateAndNavigate($element,%attrs);
+    $this->{$_current} = $this->Navigator->NavigateCreate($element,%attrs);
 }
 
 sub OnEnd {
--- a/Lib/IMPL/Object/List.pm	Fri Aug 28 16:26:20 2009 +0400
+++ b/Lib/IMPL/Object/List.pm	Wed Sep 02 17:47:44 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 {
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/DOM.t	Wed Sep 02 17:47:44 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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/DOM/Navigator.pm	Wed Sep 02 17:47:44 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;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/any.pl	Wed Sep 02 17:47:44 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;
+
+
--- a/_test/any.t	Fri Aug 28 16:26:20 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;
-
-
--- a/impl.kpf	Fri Aug 28 16:26:20 2009 +0400
+++ b/impl.kpf	Wed Sep 02 17:47:44 2009 +0400
@@ -170,7 +170,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>
@@ -178,7 +178,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>
@@ -196,7 +196,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>
@@ -204,7 +204,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>