diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/00load.t | 11 | ||||
| -rw-r--r-- | t/01simple.t | 162 | ||||
| -rw-r--r-- | t/02html.html | 146 | ||||
| -rw-r--r-- | t/02html.t | 54 | ||||
| -rw-r--r-- | t/Simple.pm | 31 |
5 files changed, 404 insertions, 0 deletions
diff --git a/t/00load.t b/t/00load.t new file mode 100644 index 0000000..814784e --- /dev/null +++ b/t/00load.t @@ -0,0 +1,11 @@ +use Test::More qw(no_plan); +BEGIN { use_ok('Class::XPath', + get_name => 'name', + get_parent => 'parent', + get_root => 'root', + get_children => 'kids', + get_attr_names => 'param', + get_attr_value => 'param', + get_content => 'data', + ); } + diff --git a/t/01simple.t b/t/01simple.t new file mode 100644 index 0000000..e73b9f9 --- /dev/null +++ b/t/01simple.t @@ -0,0 +1,162 @@ +use Test::More tests => 218; +use strict; +use warnings; +use lib 't/'; +BEGIN { use_ok('Simple') }; + +# construct a small tree +my $root = Simple->new_root(name => 'root'); +isa_ok($root, 'Simple'); +can_ok($root, 'match', 'xpath'); +$root->add_kid( + name => 'some:page', foo => 10, bar => 'bif')->add_kid( + name => 'kidfoo', data => 10); +$root->add_kid( + name => 'some:page', foo => 20, bar => 'bof')->add_kid( + name => 'kidfoo', data => 20); +$root->add_kid( + name => 'some:page', foo => 30, bar => 'bongo')->add_kid( + name => 'kidfoo', data => 30); +my @pages = $root->kids; +for my $page (@pages) { + isa_ok($page, 'Simple'); + can_ok($page, 'match', 'xpath'); + for (0 .. 9) { + $page->add_kid(name => 'paragraph', data => "$page->{bar}$_" ); + $page->add_kid(name => 'image') if $_ % 2; + } +} +#use Data::Dumper; +#warn "tree:",Dumper($root),"\n"; + +# root's xpath should be / +is($root->xpath(), '/'); + +# page xpath tests +is($pages[0]->xpath, '/some:page[0]'); +is($pages[1]->xpath, '/some:page[1]'); +is($pages[2]->xpath, '/some:page[2]'); + +# paragraph xpath tests +foreach my $page (@pages) { + my @para = grep { $_->name eq 'paragraph' } $page->kids; + for (my $x = 0; $x < $#para; $x++) { + is($para[$x]->xpath, $page->xpath . "/paragraph[$x]"); + } + my @images = grep { $_->name eq 'image' } $page->kids; + for (my $x = 0; $x < $#images; $x++) { + is($images[$x]->xpath, $page->xpath . "/image[$x]"); + } +} + +# test match against returned xpaths +is($root->match($pages[0]->xpath), 1); +is(($root->match($pages[0]->xpath))[0], $pages[0]); +is($root->match($pages[1]->xpath), 1); +is(($root->match($pages[1]->xpath))[0], $pages[1]); +is($root->match($pages[2]->xpath), 1); +is(($root->match($pages[2]->xpath))[0], $pages[2]); + +# test paragraph xpath matching, both from the page and the root +foreach my $page (@pages) { + my @para = grep { $_->name eq 'paragraph' } $page->kids; + for (my $x = 0; $x < $#para; $x++) { + is($para[$x]->match($page->xpath), 1); + is(($para[$x]->match($page->xpath))[0], $page); + is(($root->match($page->xpath))[0], $page); + } +} + +# test local name query +is($root->match('some:page'), 3); +is(($root->match('some:page'))[0]->match('paragraph'), 10); + +# test global name query +is($root->match('//paragraph'), 30); + +# test parent context +foreach my $page (@pages) { + my @para = grep { $_->name eq 'paragraph' } $page->kids; + for (my $x = 0; $x < $#para; $x++) { + is(($para[$x]->match("../paragraph[$x]"))[0], $para[$x]); + } +} + +# test string attribute matching +is($root->match('some:page[@bar="bif"]'), 1); +is(($root->match('some:page[@bar="bif"]'))[0], $pages[0]); +is($root->match('some:page[@bar="bof"]'), 1); +is(($root->match('some:page[@bar="bof"]'))[0], $pages[1]); +is($root->match("some:page[\@bar='bongo']"), 1); +is(($root->match("some:page[\@bar='bongo']"))[0], $pages[2]); + +# test numeric attribute matching +is($root->match('some:page[@foo=10]'), 1); +is(($root->match('some:page[@foo=10]'))[0], $pages[0]); +is($root->match('some:page[@foo=20]'), 1); +is(($root->match('some:page[@foo=20]'))[0], $pages[1]); +is($root->match('some:page[@foo=30]'), 1); +is(($root->match('some:page[@foo=30]'))[0], $pages[2]); + +is($root->match('some:page[@foo>10]'), 2); +is(($root->match('some:page[@foo>10]'))[0], $pages[1]); +is(($root->match('some:page[@foo>10]'))[1], $pages[2]); + +is($root->match('some:page[@foo<10]'), 0); + +is($root->match('some:page[@foo!=10]'), 2); + +is($root->match('some:page[@foo<=10]'), 1); + +is($root->match('some:page[@foo>=10]'), 3); + +# test attribute value retrieval +is($root->match('/some:page[0]/@foo'), 1); +eq_array([$root->match('/some:page/@foo')], [qw( 10 20 30 )]); +is(($root->match('/some:page[-1]/@bar'))[0], 'bongo'); +eq_array([$root->match('/some:page/@bar')], [qw( bif bof bongo )]); + +# make sure bad use of @foo is caught +eval { $root->match('/some:page[0]/@foo/bar'); }; +like($@, qr/Bad call.*contains an attribute selector in the middle of the expression/); + +# test string child matching +is($root->match('some:page[paragraph="bif0"]'), 1, "Child node string match"); +is(($root->match('some:page[paragraph="bif0"]'))[0], $pages[0]); +is($root->match('some:page[paragraph="bif3"]'), 1, "Child node string match"); +is(($root->match('some:page[paragraph="bif3"]'))[0], $pages[0]); + +is($root->match('some:page[paragraph="bof0"]'), 1, "Child node string match"); +is(($root->match('some:page[paragraph="bof0"]'))[0], $pages[1]); +is($root->match('some:page[paragraph="bof3"]'), 1, "Child node string match"); +is(($root->match('some:page[paragraph="bof3"]'))[0], $pages[1]); + +is($root->match('some:page[paragraph="bongo0"]'), 1, "Child node string match"); +is(($root->match('some:page[paragraph="bongo0"]'))[0], $pages[2]); +is($root->match('some:page[paragraph="bongo3"]'), 1, "Child node string match"); +is(($root->match('some:page[paragraph="bongo3"]'))[0], $pages[2]); + +# test numeric child matching +is($root->match('some:page[kidfoo=10]'), 1, "Child node = match"); +is(($root->match('some:page[kidfoo=10]'))[0], $pages[0]); +is($root->match('some:page[kidfoo=20]'), 1, "Child node = match"); +is(($root->match('some:page[kidfoo=20]'))[0], $pages[1]); +is($root->match('some:page[kidfoo=30]'), 1, "Child node = match"); +is(($root->match('some:page[kidfoo=30]'))[0], $pages[2]); + +is($root->match('some:page[kidfoo>10]'), 2, "Child node > match"); +is(($root->match('some:page[kidfoo>10]'))[0], $pages[1]); +is(($root->match('some:page[kidfoo>10]'))[1], $pages[2]); + +is($root->match('some:page[kidfoo<10]'), 0, "Child node < match"); + +is($root->match('some:page[kidfoo!=10]'), 2, "Child node != match"); + +is($root->match('some:page[kidfoo<=10]'), 1, "Child node <= match"); + +is($root->match('some:page[kidfoo>=10]'), 3, "Child node >= match"); + +is($root->match('some:page[.="10bif0bif1bif2bif3bif4bif5bif6bif7bif8bif9"]'), 1, +"Complex child node string match"); +is(($root->match('some:page[.="10bif0bif1bif2bif3bif4bif5bif6bif7bif8bif9"]'))[0], $pages[0]); + diff --git a/t/02html.html b/t/02html.html new file mode 100644 index 0000000..7a86dd5 --- /dev/null +++ b/t/02html.html @@ -0,0 +1,146 @@ +<html> + <head> + <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> + <link rel="stylesheet" href="/s/style.css" type="text/css"> + <title>search.cpan.org: The CPAN Search Site</title> + </head> + <body > + +<table width="100%"><tr><td rowspan=2 width="5%"> +<a href="/"><img src="/s/img/cpan_banner.png" alt="The CPAN Search Site"></a> +</td> +<td> +<div class=menubar> + <a class=m href="/">Home</a> + <a class=m href="/author/">Authors</a> + <a class=m href="/recent">Recent</a> + + <a class=m href="/site.html">About</a> + <a class=m href="/mirror">Mirrors</a> + <a class=m href="/faq.html">FAQ</a> + <a class=m href="/feedback">Feedback</a> + </div> + +</td></tr><tr><td> + +<form method=get action="/search" name=f><table><tr><td> +<input type="text" name="query" value="tree" size=35 ></td></tr><tr><td>in <select name="mode"> + <option value="all">All</option> + <option value="module" >Modules</option> + <option value="dist" >Distributions</option> + <option value="author" >Authors</option> + +</select> <input type="submit" value="CPAN Search"> +</td></tr></table> +</form> + +</td></tr></table> + + + + +<br><div class=t4> +<small> +Results <b>1</b> - <b>10</b> of +<b>1467</b> Found</small></div> + +<div class=pages><table width="100%"><tr> +<td><small> <b>1</b> · + <a href="/search?m=all&q=tree&s=11">2</a> · + <a href="/search?m=all&q=tree&s=21">3</a> · + <a href="/search?m=all&q=tree&s=31">4</a> · + + <a href="/search?m=all&q=tree&s=41">5</a> · + <a href="/search?m=all&q=tree&s=51">6</a> · + <a href="/search?m=all&q=tree&s=11">Next >></a> +</small></td> +<td align=right><small><b>Page Size</b>: +<a href="/search?m=all&q=tree&s=1&n=10">10</a> +<a href="/search?m=all&q=tree&s=1&n=20">20</a> + +<a href="/search?m=all&q=tree&s=1&n=50">50</a> +<a href="/search?m=all&q=tree&s=1&n=100">100</a> +</small></td></tr></table> +</div> + <p><a href="/author/DERHAAG/FramesReady-1.014/lib/HTTP/Response/Tree.pm"><b>HTTP::Response::Tree</b></a> +<br /><small>Class for a tree of multiple HTTP::Response objects</small> +<br /><small> <a href="/author/DERHAAG/FramesReady-1.014/">FramesReady-1.014</a> - + <span class=date>28 Apr 2002</span> - + <a href="/author/DERHAAG/">Alan E Derhaag</a> + +</small> + <p><a href="/author/MLEHMANN/Tree-M-0.03/M.pm"><b>Tree::M</b></a> +<br /><small>implement M-trees for efficient "metric/multimedia-searches"</small> +<br /><small> <a href="/author/MLEHMANN/Tree-M-0.03/">Tree-M-0.03</a> - + <span class=date>27 Jul 2001</span> - + <a href="/author/MLEHMANN/">Marc Lehmann</a> +</small> + + <p><a href="/author/RSAVAGE/Class-Tree-1.23/Tree.pm"><b>Class::Tree</b></a> +<br /><small>Build and print hierarchical information such as directory trees and C++ classes.</small> +<br /><small> <a href="/author/RSAVAGE/Class-Tree-1.23/">Class-Tree-1.23</a> - + <span class=date>22 Mar 2003</span> - + <a href="/author/RSAVAGE/">Ron Savage</a> +</small> + <p><a href="/author/SBURKE/HTML-Tree-3.17/lib/HTML/Tree.pm"><b>HTML::Tree</b></a> + +<br /><small>overview of HTML::TreeBuilder et al</small> +<br /><small> <a href="/author/SBURKE/HTML-Tree-3.17/">HTML-Tree-3.17</a> - + <span class=date>18 Jan 2003</span> - + <a href="/author/SBURKE/">Sean M. Burke</a> +</small> + <p><a href="/author/BJEPS/DBIx-Tree-1.9/Tree.pm"><b>DBIx::Tree</b></a> +<br /><small>Perl module for generating a tree from a self-referential table</small> + +<br /><small> <a href="/author/BJEPS/DBIx-Tree-1.9/">DBIx-Tree-1.9</a> - + <span class=date>14 Feb 2003</span> - + <a href="/author/BJEPS/">Brian Jepson</a> +</small> + <p><a href="/author/SWMCD/Pod-Tree-1.10/Tree.pm"><b>Pod::Tree</b></a> +<br /><small>Create a static syntax tree for a POD</small> +<br /><small> <a href="/author/SWMCD/Pod-Tree-1.10/">Pod-Tree-1.10</a> - + <span class=date>29 Jan 2003</span> - + <a href="/author/SWMCD/">Steven McDougall</a> + +</small> + <p><a href="/author/BIRNEY/bioperl-1.2/Bio/Tree/Tree.pm"><b>Bio::Tree::Tree</b></a> +<br /><small>An Implementation of TreeI interface.</small> +<br /><small> <a href="/author/BIRNEY/bioperl-1.2/">bioperl-1.2</a> - + <span class=date>31 Dec 2002</span> - + <a href="/author/BIRNEY/">Ewan Birney</a> +</small> + <p><a href="/author/BIRNEY/bioperl-1.2/Bio/Tree/RandomFactory.pm"><b>Bio::Tree::RandomFactory</b></a> + +<br /><small>TreeFactory for generating Random Trees</small> +<br /><small> <a href="/author/BIRNEY/bioperl-1.2/">bioperl-1.2</a> - + <span class=date>31 Dec 2002</span> - + <a href="/author/BIRNEY/">Ewan Birney</a> +</small> + <p><a href="/author/BIRNEY/bioperl-1.2/Bio/Tree/TreeI.pm"><b>Bio::Tree::TreeI</b></a> +<br /><small>A Tree object suitable for lots of things, designed originally for Phylogenetic Trees.</small> + +<br /><small> <a href="/author/BIRNEY/bioperl-1.2/">bioperl-1.2</a> - + <span class=date>31 Dec 2002</span> - + <a href="/author/BIRNEY/">Ewan Birney</a> +</small> + <p><a href="/author/BIRNEY/bioperl-1.2/Bio/Taxonomy/Tree.pm"><b>Bio::Taxonomy::Tree</b></a> +<br /><small>An Organism Level Implementation of TreeI interface.</small> +<br /><small> <a href="/author/BIRNEY/bioperl-1.2/">bioperl-1.2</a> - + <span class=date>31 Dec 2002</span> - + <a href="/author/BIRNEY/">Ewan Birney</a> + +</small> +<br> + +<center> <b>1</b> · + <a href="/search?m=all&q=tree&s=11">2</a> · + <a href="/search?m=all&q=tree&s=21">3</a> · + <a href="/search?m=all&q=tree&s=31">4</a> · + + <a href="/search?m=all&q=tree&s=41">5</a> · + <a href="/search?m=all&q=tree&s=51">6</a> · + <a href="/search?m=all&q=tree&s=11">Next >></a> +</center> + + </body> +</html> diff --git a/t/02html.t b/t/02html.t new file mode 100644 index 0000000..93e0eef --- /dev/null +++ b/t/02html.t @@ -0,0 +1,54 @@ +# make sure HTML::TreeBuilder is available +BEGIN { + eval { require HTML::TreeBuilder; }; + if ($@) { + eval "use Test::More skip_all => q{02html.t requires HTML::TreeBuilder.};"; + exit; + } +} + +use Test::More qw(no_plan); +use strict; +use warnings; +use Class::XPath; +use HTML::TreeBuilder; + +# build a tree from some HTML +my $root = HTML::TreeBuilder->new; +isa_ok($root, 'HTML::TreeBuilder'); +$root->parse_file("t/02html.html"); +isa_ok($root, 'HTML::Element'); + +# add Class::XPath routines to HTML::Element +Class::XPath->add_methods(target => 'HTML::Element', + call_match => 'xpath_match', + call_xpath => 'xpath_id', + get_parent => 'parent', + get_name => 'tag', + get_attr_names => + sub { my %attr = shift->all_external_attr; + return keys %attr; }, + get_attr_value => + sub { my %attr = shift->all_external_attr; + return $attr{$_[0]}; }, + get_children => + sub { grep { ref $_ } shift->content_list }, + get_content => + sub { grep { not ref $_ } shift->content_list }, + get_root => + sub { local $_=shift; + while($_->parent) { $_ = $_->parent } + return $_; }); + +# do some matching tests against the HTML +is($root->xpath_match('//table'), 3); +is($root->xpath_match('/head/title'), 1); +is($root->xpath_match('//head/title'), 1); +is(($root->xpath_match('/head/title'))[0]->xpath_id, '/head[0]/title[0]'); +is(($root->xpath_match('/head/title'))[0]->parent->xpath_id, '/head[0]'); +is(($root->xpath_match('/head/title'))[0]->parent->parent->xpath_id, '/'); +is($root->xpath_match('//a'), 54); + +my ($head) = $root->xpath_match('/head'); +is($head->xpath_match('title'), 1); +is($head->xpath_match('/title'), 0); diff --git a/t/Simple.pm b/t/Simple.pm new file mode 100644 index 0000000..1b417df --- /dev/null +++ b/t/Simple.pm @@ -0,0 +1,31 @@ +package Simple; +use strict; +use warnings; + +use Class::XPath + get_name => 'name', + get_parent => 'parent', + get_root => 'root', + get_children => 'kids', + get_attr_names => 'param', + get_attr_value => 'param', + get_content => 'data'; + + +sub name { shift->{name} } +sub parent { shift->{parent} } +sub root { local $_=shift; + while($_->{parent}) { $_ = $_->{parent} } + return $_; } +sub param { if (@_ == 2) { return $_[0]->{$_[1]} } + else { return qw(foo bar baz) } } +sub data { shift->{data} } +sub kids { @{shift->{kids}} } + +sub new_root { my $pkg = shift; bless({kids => [], @_}, $pkg); } +sub add_kid { my $self = shift; + push(@{$self->{kids}}, + bless({kids => [], @_, parent => $self }, ref $self)); + $self->{kids}[-1]; } + +1; |