r7302 - in /branches/upstream/libhtml-treebuilder-xpath-perl: ./ current/ current/lib/ current/lib/HTML/ current/lib/HTML/TreeBuilder/ current/t/
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Sun Sep 9 20:56:02 UTC 2007
Author: gregoa-guest
Date: Sun Sep 9 20:56:02 2007
New Revision: 7302
URL: http://svn.debian.org/wsvn/?sc=1&rev=7302
Log:
[svn-inject] Installing original source of libhtml-treebuilder-xpath-perl
Added:
branches/upstream/libhtml-treebuilder-xpath-perl/
branches/upstream/libhtml-treebuilder-xpath-perl/current/
branches/upstream/libhtml-treebuilder-xpath-perl/current/Changes
branches/upstream/libhtml-treebuilder-xpath-perl/current/MANIFEST
branches/upstream/libhtml-treebuilder-xpath-perl/current/META.yml
branches/upstream/libhtml-treebuilder-xpath-perl/current/Makefile.PL
branches/upstream/libhtml-treebuilder-xpath-perl/current/README
branches/upstream/libhtml-treebuilder-xpath-perl/current/lib/
branches/upstream/libhtml-treebuilder-xpath-perl/current/lib/HTML/
branches/upstream/libhtml-treebuilder-xpath-perl/current/lib/HTML/TreeBuilder/
branches/upstream/libhtml-treebuilder-xpath-perl/current/lib/HTML/TreeBuilder/XPath.pm
branches/upstream/libhtml-treebuilder-xpath-perl/current/t/
branches/upstream/libhtml-treebuilder-xpath-perl/current/t/HTML-TreeBuilder-XPath.t
branches/upstream/libhtml-treebuilder-xpath-perl/current/t/pod.t
branches/upstream/libhtml-treebuilder-xpath-perl/current/t/pod_coverage.t
branches/upstream/libhtml-treebuilder-xpath-perl/current/t/test_following.t
branches/upstream/libhtml-treebuilder-xpath-perl/current/t/test_preceding.t
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/Changes?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/Changes (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/Changes Sun Sep 9 20:56:02 2007
@@ -1,0 +1,40 @@
+$Id: /html-treebuilder-xpath/Changes 40 2006-05-15T07:42:34.182385Z mrodrigu $
+Revision history for Perl extension HTML::TreeBuilder::XPath.
+
+0.08
+
+ - fixed a bug that prevented the 'following' and 'preceding'
+ axis to work
+
+ - set version dependency with XML::XPathEngine
+
+0.07 2007-01-05
+
+ - fixed a bug that prevented the 'following' axis to be used
+
+0.06 2006-08-07
+
+ - fixed a bug that caused a crash when an element had a value of 0
+ patch by Martin Sarfy
+
+0.05 2006-05-17
+
+ - added pod and pod coverage tests
+
+0.04 2006-05-15
+
+ - changed the required version of perl from 5.8.4 to 5.6.0
+
+0.03 2006-04-20
+
+ - fixed bug that caused results not to be ordered properly when
+ there were more than 10 results (cf RT #18705) spotted by rnapier
+
+0.02 2006-02-27
+
+ - fixed dependency to XML::XPathEngine in the Makefile
+
+0.01 2006-02-15
+ - original version; created by h2xs 1.23 with options
+ -A -X -nHTML::TreeBuilder::XPath --use-new-tests --skip-exporter --skip-autoloader
+
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/MANIFEST?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/MANIFEST (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/MANIFEST Sun Sep 9 20:56:02 2007
@@ -1,0 +1,11 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/HTML-TreeBuilder-XPath.t
+lib/HTML/TreeBuilder/XPath.pm
+t/pod.t
+t/pod_coverage.t
+t/test_following.t
+t/test_preceding.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/META.yml?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/META.yml (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/META.yml Sun Sep 9 20:56:02 2007
@@ -1,0 +1,15 @@
+--- #YAML:1.0
+name: HTML-TreeBuilder-XPath
+version: 0.08
+abstract: add XPath support to HTML::TreeBuilder
+license: ~
+generated_by: ExtUtils::MakeMaker version 6.31
+distribution_type: module
+requires:
+ HTML::TreeBuilder: 0
+ XML::XPathEngine: 0.08
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+author:
+ - Michel Rodriguez <mrodrigu at localdomain>
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/Makefile.PL?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/Makefile.PL (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/Makefile.PL Sun Sep 9 20:56:02 2007
@@ -1,0 +1,12 @@
+use 5.006;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'HTML::TreeBuilder::XPath',
+ VERSION_FROM => 'lib/HTML/TreeBuilder/XPath.pm', # finds $VERSION
+ PREREQ_PM => { XML::XPathEngine => 0.08, HTML::TreeBuilder => 0, }, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/HTML/TreeBuilder/XPath.pm', # retrieve abstract from module
+ AUTHOR => 'Michel Rodriguez <mrodrigu at localdomain>') : ()),
+);
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/README?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/README (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/README Sun Sep 9 20:56:02 2007
@@ -1,0 +1,40 @@
+HTML-TreeBuilder-XPath version 0.01
+===================================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2004 by Michel Rodriguez
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.4 or,
+at your option, any later version of Perl 5 you may have available.
+
+
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/lib/HTML/TreeBuilder/XPath.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/lib/HTML/TreeBuilder/XPath.pm?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/lib/HTML/TreeBuilder/XPath.pm (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/lib/HTML/TreeBuilder/XPath.pm Sun Sep 9 20:56:02 2007
@@ -1,0 +1,406 @@
+package HTML::TreeBuilder::XPath;
+
+use strict;
+use warnings;
+
+use vars qw($VERSION);
+
+$VERSION = '0.08';
+
+package HTML::TreeBuilder::XPath;
+
+use base( 'HTML::TreeBuilder');
+
+
+package HTML::TreeBuilder::XPath::Node;
+
+sub isElementNode { 0 }
+sub isAttributeNode { 0 }
+sub isNamespaceNode { 0 }
+sub isTextNode { 0 }
+sub isProcessingInstructionNode { 0 }
+sub isPINode { 0 }
+sub isCommentNode { 0 }
+
+sub getChildNodes { return wantarray ? () : []; }
+sub getFirstChild { return undef; }
+sub getLastChild { return undef; }
+
+
+sub to_number { return XML::XPathEngine::Number->new( shift->getValue); }
+
+sub cmp
+ { my( $a, $b)=@_;
+
+ # comparison with the root (in $b, or processed in HTML::TreeBuilder::XPath::Root)
+ if( $b->isa( 'HTML::TreeBuilder::XPath::Root') ) { return -1; }
+
+ # easy cases
+ return 0 if( $a == $b);
+ return 1 if( $a->is_inside($b)); # a starts after b
+ return -1 if( $b->is_inside($a)); # a starts before b
+
+ # lineage does not include the element itself
+ my @a_pile= ($a, $a->lineage);
+ my @b_pile= ($b, $b->lineage);
+
+ # the 2 elements are not in the same twig
+ unless( $a_pile[-1] == $b_pile[-1])
+ { warn "2 nodes not in the same pile: ", ref( $a), " - ", ref( $b), "\n";
+ print "a: ", $a->string_value, "\nb: ", $b->string_value, "\n";
+ }
+ return undef unless( $a_pile[-1] == $b_pile[-1]);
+
+ # find the first non common ancestors (they are siblings)
+ my $a_anc= pop @a_pile;
+ my $b_anc= pop @b_pile;
+
+ while( $a_anc == $b_anc)
+ { $a_anc= pop @a_pile;
+ $b_anc= pop @b_pile;
+ }
+
+ if( defined( $a_anc->{_rank}) && defined( $b_anc->{_rank}))
+ { return $a_anc->{_rank} <=> $b_anc->{_rank}; }
+ else
+ { warn "no rank found";
+ # from there move left and right and figure out the order
+ my( $a_prev, $a_next, $b_prev, $b_next)= ($a_anc, $a_anc, $b_anc, $b_anc);
+ while()
+ { $a_prev= $a_prev->getPreviousSibling || return -1;
+ return 1 if( $a_prev == $b_anc);
+ $a_next= $a_next->getNextSibling || return 1;
+ return -1 if( $a_next == $b_anc);
+ $b_prev= $b_prev->getPreviousSibling || return 1;
+ return -1 if( $b_prev == $a_next);
+ $b_next= $b_next->getNextSibling || return -1;
+ return 1 if( $b_next == $a_prev);
+ }
+ }
+ }
+
+
+# need to modify directly the HTML::Element package, because HTML::TreeBuilder won't let me
+# change the class of the nodes it generates
+package HTML::Element;
+use Scalar::Util qw(weaken);
+use vars qw(@ISA);
+
+push @ISA, 'HTML::TreeBuilder::XPath::Node';
+
+use XML::XPathEngine;
+
+{ my $xp;
+ sub xp
+ { $xp ||=XML::XPathEngine->new();
+ return $xp;
+ }
+}
+
+sub findnodes { my( $elt, $path)= @_; return xp->findnodes( $path, $elt); }
+sub findnodes_as_string { my( $elt, $path)= @_; return xp->findnodes_as_string( $path, $elt); }
+sub findvalue { my( $elt, $path)= @_; return xp->findvalue( $path, $elt); }
+sub exists { my( $elt, $path)= @_; return xp->exists( $path, $elt); }
+sub find_xpath { my( $elt, $path)= @_; return xp->find( $path, $elt); }
+sub matches { my( $elt, $path)= @_; return xp->matches( $elt, $path, $elt); }
+sub set_namespace { my $elt= shift; xp->new->set_namespace( @_); }
+
+sub getRootNode
+ { my $elt= shift;
+ # The parent of root is a HTML::TreeBuilder::XPath::Root
+ # that helps getting the tree to mimic a DOM tree
+ return $elt->root->getParentNode; # I like this one!
+ }
+
+sub getParentNode
+ { my $elt= shift;
+ return $elt->{_parent} || bless { _root => $elt }, 'HTML::TreeBuilder::XPath::Root';
+ }
+sub getName { return shift->tag; }
+sub getNextSibling { my( $elt)= @_;
+ my $parent= $elt->{_parent} || return undef;
+ return $parent->_child_as_object( scalar $elt->right, ($elt->{_rank} || 0) + 1);
+ }
+sub getPreviousSibling { my( $elt)= @_;
+ my $parent= $elt->{_parent} || return undef;
+ return undef unless $elt->{_rank};
+ return $parent->_child_as_object( scalar $elt->left, $elt->{_rank} - 1);
+ }
+sub isElementNode { return ref $_[0] && ($_[0]->{_tag}!~ m{^~}) ? 1 : 0; }
+sub isCommentNode { return ref $_[0] && ($_[0]->{_tag} eq '~comment') ? 1 : 0; }
+sub isProcessingInstructionNode { return ref $_[0] && ($_[0]->{_tag} eq '~pi') ? 1 : 0; }
+sub isTextNode { return ref $_[0] ? 0 : 1; }
+
+sub getValue
+ { my $elt= shift;
+ if( $elt->isCommentNode) { return $elt->{_text}; }
+ return $elt->as_text;
+ }
+
+sub getChildNodes
+ { my $parent= shift;
+ my $rank=0;
+ my @children= map { $parent->_child_as_object( $_, $rank++) } $parent->content_list;
+ return wantarray ? @children : \@children;
+ }
+
+sub getFirstChild
+ { my $parent= shift;
+ my @content= $parent->content_list;
+ if( @content)
+ { return $parent->_child_as_object( $content[0], 0); }
+ else
+ { return undef; }
+ }
+sub getLastChild
+ { my $parent= shift;
+ my @content= $parent->content_list;
+ if( @content)
+ { return $parent->_child_as_object( $content[-1], $#content); }
+ else
+ { return undef; }
+ }
+
+sub getAttributes
+ { my $elt= shift;
+ my %atts= $elt->all_external_attr;
+ my $rank=0;
+ my @atts= map { bless( { _name => $_, _value => $atts{$_},
+ _elt => $elt, _rank => $rank++,
+ },
+ 'HTML::TreeBuilder::XPath::Attribute'
+ )
+ } sort keys %atts;
+ return wantarray ? @atts : \@atts;
+ }
+
+sub to_number { return XML::XPathEngine::Number->new( $_[0]->as_text); }
+sub string_value
+ { my $elt= shift;
+ if( $elt->isCommentNode) { return $elt->{_text}; }
+ return $elt->as_text;
+ };
+
+# called on a parent, with a child as second argument and its rank as third
+# returns the child if it is already an element, or
+# a new HTML::TreeBuilder::XPath::Text element if it is a plain string
+sub _child_as_object
+ { my( $elt, $elt_or_text, $rank)= @_;
+ return undef unless( defined $elt_or_text);
+ if( ! ref $elt_or_text)
+ { # $elt_or_text is a string, turn it into a TextNode object
+ $elt_or_text= bless { _content => $elt_or_text, _parent => $elt, },
+ 'HTML::TreeBuilder::XPath::TextNode'
+ ;
+ }
+ if( ref $rank) { warn "rank is a ", ref( $rank), " elt_or_text is a ", ref( $elt_or_text); }
+ $elt_or_text->{_rank}= $rank; # used for sorting;
+ return $elt_or_text;
+ }
+
+package HTML::TreeBuilder::XPath::TextNode;
+
+use base 'HTML::TreeBuilder::XPath::Node';
+
+sub getParentNode { return shift->{_parent}; }
+sub getValue { return shift->{_content}; }
+sub isTextNode { return 1; }
+sub getAttributes { return wantarray ? () : []; }
+sub as_XML { return shift->getValue; }
+
+
+sub getPreviousSibling
+ { my $self= shift;
+ my $rank= $self->{_rank};
+ #unless( defined $self->{_rank})
+ # { warn "no rank for text node $self->{_content}, parent is $self->{_parent}->{_tag}\n"; }
+ my $parent= $self->{_parent};
+ return $rank ? $parent->_child_as_object( $parent->{_content}->[$rank-1], $rank-1) : undef;
+ }
+
+sub getNextSibling
+ { my $self= shift;
+ my $rank= $self->{_rank};
+ #unless( defined $self->{_rank})
+ # { warn "no rank for text node $self->{_content}, parent is $self->{_parent}->{_tag}\n"; }
+ my $parent= $self->{_parent};
+ my $next_sibling= $parent->{_content}->[$rank+1];
+ return defined( $next_sibling) ? $parent->_child_as_object( $next_sibling, $rank+1) : undef;
+ }
+
+sub getRootNode
+ { return shift->{_parent}->getRootNode; }
+
+sub string_value { return shift->{_content}; }
+
+# added to provide element-like methods to text nodes, for use by cmp
+sub lineage
+ { my( $node)= @_;
+ my $parent= $node->{_parent};
+ return( $parent, $parent->lineage);
+ }
+
+sub is_inside
+ { my( $text, $node)= @_;
+ return $text->{_parent}->is_inside( $node);
+ }
+
+1;
+
+
+package HTML::TreeBuilder::XPath::Attribute;
+use base 'HTML::TreeBuilder::XPath::Node';
+
+sub getParentNode { return $_[0]->{_elt}; }
+sub getValue { return $_[0]->{_value}; }
+sub getName { return $_[0]->{_name} ; }
+sub getLocalName { (my $name= $_[0]->{_name}) =~ s{^.*:}{}; $name; }
+sub string_value { return $_[0]->{_value}; }
+sub to_number { return XML::XPathEngine::Number->new( $_[0]->{_value}); }
+sub isAttributeNode { 1 }
+sub toString { return qq{$_[0]->{_name}="$_[0]->{_value}"}; }
+
+# awfully inefficient, but hopefully this is called only for weird (read test-case) queries
+sub getPreviousSibling
+ { my $self= shift;
+ my $rank= $self->{_rank};
+ return undef unless $rank;
+ my %atts= $self->{_elt}->all_external_attr;
+ my $previous_att_name= (sort keys %atts)[$rank-1];
+ return bless( { _name => $previous_att_name,
+ _value => $atts{$previous_att_name},
+ _elt => $self->{_elt}, _rank => $rank-1,
+ }, 'HTML::TreeBuilder::XPath::Attribute'
+ );
+ }
+
+sub getNextSibling
+ { my $self= shift;
+ my $rank= $self->{_rank};
+ my %atts= $self->{_elt}->all_external_attr;
+ my $next_att_name= (sort keys %atts)[$rank+1] || return undef;
+ return bless( { _name => $next_att_name, _value => $atts{$next_att_name},
+ _elt => $self->{_elt}, _rank => $rank+1,
+ }, 'HTML::TreeBuilder::XPath::Attribute'
+ );
+
+ }
+
+
+
+# added to provide element-like methods to attributes, for use by cmp
+sub lineage
+ { my( $att)= @_;
+ my $elt= $att->{_elt};
+ return( $elt, $elt->lineage);
+ }
+
+sub is_inside
+ { my( $att, $node)= @_;
+ return ($att->{_elt} == $node) || $att->{_elt}->is_inside( $node);
+ }
+
+1;
+
+
+package HTML::TreeBuilder::XPath::Root;
+
+use base 'HTML::TreeBuilder::XPath::Node';
+
+sub getParentNode { return (); }
+sub getChildNodes { my @content= ( $_[0]->{_root}); return wantarray ? @content : \@content; }
+sub getAttributes { return [] }
+sub isDocumentNode { return 1 }
+
+# added to provide element-like methods to root, for use by cmp
+sub lineage { return ($_[0]); }
+sub is_inside { return 0; }
+sub cmp { return $_[1]->isa( ' HTML::TreeBuilder::XPath::Root') ? 0 : 1; }
+
+1;
+
+__END__
+=head1 NAME
+
+HTML::TreeBuilder::XPath - add XPath support to HTML::TreeBuilder
+
+=head1 SYNOPSIS
+
+ use HTML::TreeBuilder::XPath;
+ my $tree= HTML::TreeBuilder::XPath->new;
+ $tree->parse_file( "mypage.html");
+ my $nb=$tree->findvalue( '/html/body//p[@class="section_title"]/span[@class="nb"]');
+ my $id=$tree->findvalue( '/html/body//p[@class="section_title"]/@id');
+
+ my $p= $html->findnodes( '//p[@id="toto"]')->[0];
+ my $link_texts= $p->findvalue( './a'); # the texts of all a elements in $p
+
+
+=head1 DESCRIPTION
+
+This module adds typical XPath methods to HTML::TreeBuilder, to make it
+easy to query a document.
+
+=head1 METHODS
+
+Extra methods added both to the tree object and to each element:
+
+=head2 findnodes ($path)
+
+Returns a list of nodes found by C<$path>.
+In scalar context returns an C<Tree::XPathEngine::NodeSet> object.
+
+=head2 findnodes_as_string ($path)
+
+Returns the text values of the nodes
+
+=head2 findvalue ($path)
+
+Returns either a C<Tree::XPathEngine::Literal>, a C<Tree::XPathEngine::Boolean>
+or a C<Tree::XPathEngine::Number> object. If the path returns a NodeSet,
+$nodeset->xpath_to_literal is called automatically for you (and thus a
+C<Tree::XPathEngine::Literal> is returned). Note that
+for each of the objects stringification is overloaded, so you can just
+print the value found, or manipulate it in the ways you would a normal
+perl value (e.g. using regular expressions).
+
+=head2 exists ($path)
+
+Returns true if the given path exists.
+
+=head2 matches($path)
+
+Returns true if the element matches the path.
+
+=head2 find ($path)
+
+The find function takes an XPath expression (a string) and returns either a
+Tree::XPathEngine::NodeSet object containing the nodes it found (or empty if
+no nodes matched the path), or one of XML::XPathEngine::Literal (a string),
+XML::XPathEngine::Number, or XML::XPathEngine::Boolean. It should always
+return something - and you can use ->isa() to find out what it returned. If
+you need to check how many nodes it found you should check $nodeset->size.
+See L<XML::XPathEngine::NodeSet>.
+
+
+
+=head1 SEE ALSO
+
+L<HTML::TreeBuilder>
+
+L<XML::XPathEngine>
+
+=head1 AUTHOR
+
+Michel Rodriguez, E<lt>imirod at cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2006 by Michel Rodriguez
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.4 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/t/HTML-TreeBuilder-XPath.t
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/t/HTML-TreeBuilder-XPath.t?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/t/HTML-TreeBuilder-XPath.t (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/t/HTML-TreeBuilder-XPath.t Sun Sep 9 20:56:02 2007
@@ -1,0 +1,61 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl HTML-TreeBuilder-XPath.t'
+
+#########################
+
+use Test::More tests => 17;
+BEGIN { use_ok('HTML::TreeBuilder::XPath') };
+
+#########################
+
+my $doc='<html>
+ <head><title>Example</title></head>
+ <body><h1>Example header</h1>
+ <div class="intro"><p>Intro p1</p><p>Intro p2</p><p>Intro p3 with <b>bold</b> text</p></div>
+ <p id="toto">para including <a href="http://foo.com/">links</a>, <a href="/bar/">more links</a>,
+ and even <span id="foo" class="myspan">spans</span>, <span class="myspan" id="bar">several</span>,
+ and that is <b>all</b> folks.</p>
+ <!-- a commented line break --><br>
+ <blockquote id="bq" bgcolor="0">0</blockquote>
+ </body>
+ </html>
+ ';
+
+my $html= HTML::TreeBuilder::XPath->new_from_content( $doc);
+
+
+is( $html->findvalue( '//p[@id]/@id'), 'toto', 'attribute value');
+is( $html->findvalue( '//title'), 'Example', 'element text');
+is( $html->findvalue( '//span[1]'), 'spans', '[1]');
+is( $html->findvalue( '/html/body//p[@id="toto"]/*[@id="bar"]/@class'), 'myspan', 'attribute');
+is( $html->findvalue( '//p[@id="toto"]/text()[2]'), ', ', 'text node');
+
+# test sorting
+is( $html->findvalue( '//*[@id="foo"]/@*'), 'myspanfoo', '2 atts on same element');
+is( $html->findvalue( '//*[@id="foo"]/@id|//*[@id="foo"]/@class'), 'myspanfoo', '2 atts on same element');
+is( $html->findvalue( '//*[@id="foo"]/@class|//*[@id="foo"]/@id'), 'myspanfoo', '2 atts on same element (unsorted)');
+
+is( $html->findvalue( '//b'), 'boldall', '2 texts');
+is( $html->findvalue( '//p[@id="toto"]/a'), 'linksmore links', '2 siblings');
+is( $html->findvalue( '//p[@id="toto"]/a[1]|//p[@id="toto"]/a[2]'), 'linksmore links', '2 siblings');
+
+is( $html->findvalue( '//@id[.="toto"]|//*[@id="bar"]|/html/body/h1|//@id[.="toto"]/../a[1]|//*[@id="foo"]'), 'Example headertotolinksspansseveral',
+ 'query on various types of nodes');
+
+
+is( $html->findvalue( './/*[@bgcolor="0"]'),'0', 'one child has a value of "0"');
+
+{
+my $p= $html->findnodes( '//p[@id="toto"]')->[0];
+is( $p->findvalue( './a'), 'linksmore links', 'query on siblings of an element');
+is( $p->findvalue( './a[1]|./a[2]'), 'linksmore links', 'query on siblings of an element (ordered)');
+is( $p->findvalue( './a[2]|./a[1]'), 'linksmore links', 'query on siblings of an element (not ordered)');
+
+}
+
+__END__
+/html/body/h1 1 Example header
+//@id[.="toto"] 2 toto
+//@id[.="toto"]/../a[1] 3 links
+//*[@id="foo"] 4 spans
+//*[@id="bar"] 5 several
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/t/pod.t?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/t/pod.t (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/t/pod.t Sun Sep 9 20:56:02 2007
@@ -1,0 +1,5 @@
+eval "use Test::Pod 1.00";
+if( $@) { print "1..1\nok 1\n"; warn "skipping, Test::Pod required\n"; }
+else { all_pod_files_ok( ); }
+exit 0;
+
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/t/pod_coverage.t
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/t/pod_coverage.t?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/t/pod_coverage.t (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/t/pod_coverage.t Sun Sep 9 20:56:02 2007
@@ -1,0 +1,10 @@
+# $Id: /html-treebuilder-xpath/t/pod_coverage.t 40 2006-05-15T07:42:34.182385Z mrodrigu $
+
+eval "use Test::Pod::Coverage 1.00 tests => 1";
+if( $@)
+ { print "1..1\nok 1\n";
+ warn "Test::Pod::Coverage 1.00 required for testing POD coverage";
+ exit;
+ }
+
+pod_coverage_ok( "HTML::TreeBuilder::XPath");
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/t/test_following.t
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/t/test_following.t?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/t/test_following.t (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/t/test_following.t Sun Sep 9 20:56:02 2007
@@ -1,0 +1,85 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use HTML::TreeBuilder::XPath;
+use Test::More tests => 47;
+
+my $html=q{
+<html>
+ <head />
+ <body>
+ <a name="a1">foo</a>
+ <p class="c1" id="ip1">p1</p>
+ <p id="ip2">f1</p>
+ <p class="c1" id="ip3">p2</p>
+ <p id="ip4">f2</p>
+ <p id="ip5">f3</p>
+ </body>
+</html>};
+
+my $tree = HTML::TreeBuilder->new_from_content( $html);
+
+test_q( $tree, q{//p[@class="c1"]}, "p1p2");
+test_q( $tree, q{//p[@class="c1"]/following::p[1]}, "f1f2");
+
+test_q( $tree, q{//body/descendant::p[1]}, "p1");
+test_q( $tree, q{//body/descendant::p[2]}, "f1");
+test_q( $tree, q{//body/descendant::p[3]}, "p2");
+test_q( $tree, q{//body/descendant::p[4]}, "f2");
+test_q( $tree, q{//body/descendant::p[5]}, "f3");
+test_q( $tree, q{//body/descendant::p[6]}, "" );
+
+test_q( $tree, q{//body/p[1]}, "p1");
+test_q( $tree, q{//body/p[2]}, "f1");
+test_q( $tree, q{//body/p[3]}, "p2");
+test_q( $tree, q{//body/p[4]}, "f2");
+test_q( $tree, q{//body/p[5]}, "f3");
+test_q( $tree, q{//body/p[6]}, "" );
+
+test_q( $tree, q{//body//p[1]}, "p1");
+test_q( $tree, q{//body//p[2]}, "f1");
+test_q( $tree, q{//body//p[3]}, "p2");
+test_q( $tree, q{//body//p[4]}, "f2");
+test_q( $tree, q{//body//p[5]}, "f3");
+test_q( $tree, q{//body//p[6]}, "" );
+
+test_q( $tree, q{//p[1]}, "p1");
+test_q( $tree, q{//p[2]}, "f1");
+test_q( $tree, q{//p[3]}, "p2");
+test_q( $tree, q{//p[4]}, "f2");
+test_q( $tree, q{//p[5]}, "f3");
+test_q( $tree, q{//p[6]}, "" );
+
+test_q( $tree, q{//a/following::p}, "p1f1p2f2f3");
+
+test_q( $tree, q{//p[@class="c1"][1]}, "p1");
+test_q( $tree, q{//p[@class="c1"][2]}, "p2");
+
+test_q( $tree, q{//a/following::p[1]}, "p1");
+test_q( $tree, q{//a/following::p[2]}, "f1");
+test_q( $tree, q{//a/following::p[3]}, "p2");
+test_q( $tree, q{//a/following::p[4]}, "f2");
+test_q( $tree, q{//a/following::p[5]}, "f3");
+
+test_q( $tree, q{//p[@id="ip1"]/following::p[1]}, "f1");
+test_q( $tree, q{//p[@id="ip1"][1]/following::p[1]}, "f1");
+test_q( $tree, q{//p[@id="ip1"][1]/following::p[2]}, "p2");
+test_q( $tree, q{//p[@id="ip1"][1]/following::p[3]}, "f2");
+test_q( $tree, q{//p[@id="ip1"][1]/following::p[4]}, "f3");
+test_q( $tree, q{//p[@id="ip3"]/following::p[1]}, "f2");
+test_q( $tree, q{//p[@id="ip3"]/following::p[2]}, "f3");
+
+test_q( $tree, q{//p[@class="c1"][1]/following::p[1]}, "f1");
+test_q( $tree, q{//p[@class="c1"][1]/following::p[2]}, "p2");
+test_q( $tree, q{//p[@class="c1"][1]/following::p[3]}, "f2");
+test_q( $tree, q{//p[@class="c1"][1]/following::p[4]}, "f3");
+test_q( $tree, q{//p[@class="c1"][2]/following::p[1]}, "f2");
+test_q( $tree, q{//p[@class="c1"][2]/following::p[2]}, "f3");
+
+sub test_q
+ { my( $tree, $query, $expected)= @_;
+ my $class= ref( $tree);
+ is( $tree->findvalue( $query), $expected, "$class: $query ($expected)");
+ }
Added: branches/upstream/libhtml-treebuilder-xpath-perl/current/t/test_preceding.t
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-treebuilder-xpath-perl/current/t/test_preceding.t?rev=7302&op=file
==============================================================================
--- branches/upstream/libhtml-treebuilder-xpath-perl/current/t/test_preceding.t (added)
+++ branches/upstream/libhtml-treebuilder-xpath-perl/current/t/test_preceding.t Sun Sep 9 20:56:02 2007
@@ -1,0 +1,32 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use HTML::TreeBuilder::XPath;
+use Test::More tests => 3;
+
+my $html=q{
+<html>
+ <head />
+ <body>
+ <a name="a1">foo</a>
+ <p class="c1" id="ip1">p1</p>
+ <p id="ip2">f1</p>
+ <p class="c1" id="ip3">p2</p>
+ <p id="ip4">f2</p>
+ <p id="ip5">f3</p>
+ </body>
+</html>};
+
+my $tree = HTML::TreeBuilder->new_from_content( $html);
+
+test_q( $tree, q{//p[@class="c1"][2]/preceding::p[1]}, "f1");
+test_q( $tree, q{//p[@class="c1"][2]/preceding::p[2]}, "p1");
+test_q( $tree, q{//p[@class="c1"][2]/preceding::p}, "p1f1");
+
+sub test_q
+ { my( $tree, $query, $expected)= @_;
+ my $class= ref( $tree);
+ is( $tree->findvalue( $query), $expected, "$class: $query ($expected)");
+ }
More information about the Pkg-perl-cvs-commits
mailing list