Mercurial > pub > Impl
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>