HTML-TreeBuilder-XPath-0.14/0000755000175000017500000000000011635767033015705 5ustar mrodrigumrodriguHTML-TreeBuilder-XPath-0.14/MANIFEST0000644000175000017500000000047711635767033017046 0ustar mrodrigumrodriguChanges 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) META.json Module JSON meta-data (added by MakeMaker) HTML-TreeBuilder-XPath-0.14/lib/0000755000175000017500000000000011635767033016453 5ustar mrodrigumrodriguHTML-TreeBuilder-XPath-0.14/lib/HTML/0000755000175000017500000000000011635767033017217 5ustar mrodrigumrodriguHTML-TreeBuilder-XPath-0.14/lib/HTML/TreeBuilder/0000755000175000017500000000000011635767033021425 5ustar mrodrigumrodriguHTML-TreeBuilder-XPath-0.14/lib/HTML/TreeBuilder/XPath.pm0000644000175000017500000005173111635767000023010 0ustar mrodrigumrodrigupackage HTML::TreeBuilder::XPath; use List::Util qw( first); use Scalar::Util (); use strict; use warnings; use vars qw($VERSION); $VERSION = '0.14'; my %CHAR2DEFAULT_ENT= ( '&' => '&', '<' => '<', '>' => '>', '"' => '"'); my %NUM2DEFAULT_ENT= ( '38' => 'amp', '60' => 'lt', '62' => 'gt', '"' => '"'); 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; } # need to do a complete look_down each time, as the id could have been changed # without any object being involved, hence without a potential cache being # up to date sub getElementById { my ($self, $id) = @_; return scalar $self->look_down( id => $id); } 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; } # 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 { # 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 findnodes_as_strings { my( $elt, $path)= @_; return xp->findnodes_as_strings( $path, $elt); } sub findvalue { my( $elt, $path)= @_; return xp->findvalue( $path, $elt); } sub findvalues { my( $elt, $path)= @_; return xp->findvalues( $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 getLocalName { (my $name= $_[0]->tag) =~ s{^.*:}{}; $name; } 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' ; Scalar::Util::weaken($elt_or_text->{_parent}); } 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; } sub toString { return shift->as_XML( @_); } # produces better looking XML { no warnings 'redefine'; sub as_XML_compact { my( $node, $opt)= @_; my $name = $node->{'_tag'}; if( $name eq '~literal') { return _xml_escape_text( $node->{text}); } if( $name eq '~declaration') { return '{text}) . ">"; } if( $name eq '~pi') { return '{text}) . '?>'; } if( $name eq '~comment') { return ''; } my $lc_name= lc $name; my $xml= $node->_start_tag; if( $HTML::Tagset::isCDATA_Parent{$lc_name}) { my $content= $node->{_content} || ''; if( ref $content eq 'ARRAY' || $content->isa( 'ARRAY')) { $xml .= _xml_escape_cdata( join( '', @$content), $opt); } else { $xml .= $content; } } else { # start tag foreach my $child ($node->content_list) { if( ref $child) { $xml .= $child->as_XML_compact(); } else { $xml .= _xml_escape_text( $child); } } } $xml.= "" unless $HTML::Tagset::emptyElement{$lc_name}; return $xml; } } { my %phrase_name; # all phrase tags, + literals (those are not indented) my %extra_newline; # tags that get an extra newline before the end tag my $default_indent; # 2 spaces, change with the 'indent' option BEGIN { %phrase_name= %HTML::Tagset::isPhraseMarkup; $phrase_name{'~literal'}= 1; $default_indent= ' '; %extra_newline= map { $_ => 1 } qw(html head body script div table tbody thead tfoot tr form dl ol ul); } sub as_XML_indented { my( $node, $opt)= @_; my $name = $node->{'_tag'}; my $lc_name= lc $name; if( $name eq '~literal') { return _xml_escape_text( $node->{text}); } if( $name eq '~declaration') { return '{text}) . ">\n"; } if( $name eq '~pi') { return '{text}) . '?>'; } if( $name eq '~comment') { return ''; } my $xml; my $pre_tag_indent=''; if(!$phrase_name{$lc_name}) { $pre_tag_indent= "\n" . ($opt->{indent} || $default_indent) x ($opt->{indent_level}||0); } if( $opt->{indent_level}) { $xml .= $pre_tag_indent; } $xml.= $node->_start_tag(); my $content=''; if( $HTML::Tagset::isCDATA_Parent{$lc_name}) { my $content= $node->{_content} || ''; if( ref $content && (ref $content eq 'ARRAY' || $content->isa( 'ARRAY') )) { $content= _xml_escape_cdata( join( '', @$content), $opt); } } else { my %child_opt= %$opt; $child_opt{indent_level}++; foreach my $child ($node->content_list) { if( ref $child) { $content .= $child->as_XML_indented( \%child_opt ); } else { $content .= _xml_escape_text( $child); } } } $xml .= $content; if( $extra_newline{$lc_name} && $content ne '' ) { $xml.= $pre_tag_indent; } $xml.= "" unless $HTML::Tagset::emptyElement{$lc_name}; $xml .="\n" if( !$opt->{indent_level}); return $xml; } } sub _start_tag { my( $node)= @_; my $name = $node->{'_tag'}; my $start_tag.= "<$name"; foreach my $att_name (sort keys %$node) { next if( (!length $att_name) || ($att_name=~ m{^_}) || ($att_name eq '/') ); my $well_formed_att_name= well_formed_name( $att_name); $start_tag .= qq{ $well_formed_att_name="} . _xml_escape_attribute_value( $node->{$att_name}) . qq{"}; } $start_tag.= $HTML::Tagset::emptyElement{lc $name} ? " />" : ">"; return $start_tag; } sub well_formed_name { my( $name)= @_; $name=~ s{[^\w:_-]+}{_}g; if( $name=~ m{^\d}) { $name= "a$name"; } return $name; } sub _indent_level { my( $node)= @_; my $level= scalar grep { !$HTML::Tagset::isPhraseMarkup{lc $_->{_tag}} } $node->lineage; return $level; } { my( $indent, %extra_newline, $nl); BEGIN { $indent= ' '; $nl= "\n"; %extra_newline= map { $_ => 1 } qw(html head body script div table tr form ol ul); } sub indents { my( $opt, $name)= @_; my $indents= { pre_start_tag => '', post_start_tag => '', pre_end_tag => '', post_end_tag => ''}; if( $opt->{indented}) { my $indent_level= $opt->{indent_level}; my $wrapping_nl= $nl; if( !defined( $indent_level)) { $indent_level = 0; $wrapping_nl= ''; } if( $HTML::Tagset::isKnown{lc $name} && !$HTML::Tagset::isPhraseMarkup{lc $name} && $indent_level > 0) { $indents->{pre_start_tag}= $wrapping_nl . ($indent x $indent_level); } if( $extra_newline{lc $name}) { $indents->{post_start_tag}= $nl; $indents->{pre_end_tag}= $nl . ($indent x $indent_level); } if( $indent_level == 0) { $indents->{post_end_tag} = $wrapping_nl; } } return $indents; } } sub _xml_escape_attribute_value { my( $text)= @_; $text=~ s{([&<>"])}{$CHAR2DEFAULT_ENT{$1}}g; # escape also quote, as it is the attribute separator return $text; } sub _xml_escape_text { my( $text)= @_; $text=~ s{([&<>])}{$CHAR2DEFAULT_ENT{$1}}g; return $text; } sub _xml_escape_comment { my( $text)= @_; $text=~ s{([&<>])}{$CHAR2DEFAULT_ENT{$1}}g; $text=~ s{--}{--}g; # can't have double --'s in XML comments return $text; } sub _xml_escape_cdata { my( $text, $opt)= @_; if( $opt->{force_escape_cdata} || $text=~ m{[<&]}) { $text=~ s{^\s*\Q\E\s*$}{}s; $text=~ s{]]>}{]]>}g; # can't have]]> in CDATA $text= ""; } return $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 ? () : []; } # similar to HTML::Element as_XML sub as_XML { my( $node, $entities)= @_; my $content= $node->{_content}; if( $node->{_parent} && $node->{_parent}->{_tag} eq 'script') { $content=~ s{(&\w+;)}{HTML::Entities::decode($1)}eg; } else { $content= HTML::Element::_xml_escape_text($content); } return $content; } *as_XML_compact = *as_XML; *as_XML_indented = *as_XML; 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}"}; } sub getAttributes { return $_[0]->{_elt}->getAttributes; } # 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 } sub getRootNode { return $_[0] } sub getName { return } sub getNextSibling { return } sub getPreviousSibling { return } # 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 $tree->delete; # to avoid memory leaks, if you parse many HTML documents =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 object. =head2 findnodes_as_string ($path) Returns the text values of the nodes, as one string. =head2 findnodes_as_strings ($path) Returns a list of the values of the result nodes. =head2 findvalue ($path) Returns either a C, a C or a C object. If the path returns a NodeSet, $nodeset->xpath_to_literal is called automatically for you (and thus a C 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 findvalues ($path) Returns the values of the matching nodes as a list. This is mostly the same as findnodes_as_strings, except that the elements of the list are objects (with overloaded stringification) instead of plain strings. =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. =head2 as_XML_compact HTML::TreeBuilder's C output is not really nice to look at, so I added a new method, that can be used as a simple replacement for it. It escapes only the '<', '>' and '&' (plus '"' in attribute values), and wraps CDATA elements in CDATA sections. Note that the XML is actually not garanteed to be valid at this point. Nothing is done about the encoding of the string. Patches or just ideas of how it could work are welcome. =head2 as_XML_indented Same as as_XML, except that the output is indented. =head1 SEE ALSO L L =head1 REPOSITORY L =head1 AUTHOR Michel Rodriguez, Emirod@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006-2011 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 HTML-TreeBuilder-XPath-0.14/t/0000755000175000017500000000000011635767033016150 5ustar mrodrigumrodriguHTML-TreeBuilder-XPath-0.14/t/pod.t0000644000175000017500000000021611444212634017104 0ustar mrodrigumrodrigueval "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; HTML-TreeBuilder-XPath-0.14/t/test_following.t0000644000175000017500000000535511444212634021372 0ustar mrodrigumrodrigu#!/usr/bin/perl use strict; use warnings; use HTML::TreeBuilder::XPath; use Test::More tests => 47; my $html=q{ foo

p1

f1

p2

f2

f3

}; 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)"); } HTML-TreeBuilder-XPath-0.14/t/pod_coverage.t0000644000175000017500000000046211444212634020762 0ustar mrodrigumrodrigu# $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"); HTML-TreeBuilder-XPath-0.14/t/HTML-TreeBuilder-XPath.t0000644000175000017500000000731411444212634022322 0ustar mrodrigumrodrigu# 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 => 29; BEGIN { use_ok('HTML::TreeBuilder::XPath') }; ######################### my $doc=' Example

Example header

Intro p1

Intro p2

Intro p3 with bold text

para including links, more links, and even spans, several, and that is all folks.


0
'; 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( join( '|', $html->findvalues( '//b')), 'bold|all', '2 texts with findvalues'); is( join( '|', $html->findnodes_as_strings( '//b')), 'bold|all', '2 texts with findnodes_as_strings'); is( join( '|', $html->findvalues( '//a/@href')), 'http://foo.com/|/bar/', '2 texts with findvalues'); is( join( '|', $html->findnodes_as_strings( '//a/@href')), 'http://foo.com/|/bar/', '2 texts with findnodes_as_strings'); 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)'); is( $html->findvalue('id("foo")'), 'spans', 'id function'); is( $html->findvalue('id("foo")/@id'), 'foo', 'id function (attribute)'); } { # test for root my ($fake_root)=$html->findnodes('/'); ok( !$fake_root->getParentNode => "fake root does not have a parent"); is( $fake_root->getRootNode, $fake_root, "fake root is its own root"); ok( !@{$fake_root->getAttributes} => "fake root has no attributes"); ok( !defined($fake_root->getName) => "fake root does not have a name"); ok( !defined($fake_root->getNextSibling) => "fake root does not have a next sibling"); ok( !defined($fake_root->getPreviousSibling) => "fake root does not have a prev sibling"); } __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 HTML-TreeBuilder-XPath-0.14/t/test_preceding.t0000644000175000017500000000132711444212634021325 0ustar mrodrigumrodrigu#!/usr/bin/perl use strict; use warnings; use HTML::TreeBuilder::XPath; use Test::More tests => 3; my $html=q{ foo

p1

f1

p2

f2

f3

}; 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)"); } HTML-TreeBuilder-XPath-0.14/Makefile.PL0000644000175000017500000000135311444212634017647 0ustar mrodrigumrodriguuse 5.006; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. (my $EUMM= $ExtUtils::MakeMaker::VERSION)=~ tr/_//d; my @license = $EUMM > 6.30 ? qw(LICENSE perl) : (); WriteMakefile( NAME => 'HTML::TreeBuilder::XPath', VERSION_FROM => 'lib/HTML/TreeBuilder/XPath.pm', # finds $VERSION PREREQ_PM => { XML::XPathEngine => 0.12, HTML::TreeBuilder => 0, List::Util => 0 }, @license, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/HTML/TreeBuilder/XPath.pm', # retrieve abstract from module AUTHOR => 'Michel Rodriguez ') : ()), ); HTML-TreeBuilder-XPath-0.14/Changes0000644000175000017500000000533211635764566017213 0ustar mrodrigumrodrigu$Id: /html-treebuilder-xpath/Changes 40 2006-05-15T07:42:34.182385Z mrodrigu $ Revision history for Perl extension HTML::TreeBuilder::XPath. version 0.14 date: 2011-09-20 # bug fix fix: comment() did not work, as the text was in {text} not {_text} report and initial patch by perlover version 0.13 date: 2011-06-19 # minor improvement added: make the link _parent a weakref sent by Graham Barr https://rt.cpan.org/Public/Bug/Display.html?id=68896 version 0.12 date: 2010-09-29 # minor bug fix fix: added getLocalName on elements see https://rt.cpan.org/Public/Bug/Display.html?id=61746 found and fixed by Tokuhiro Matsuno added: a few tests version 0.11 date: 2009-05-19 # minor bug fixes added: mention $tree->delete in docs to warn about memory leaks fix: pod fix (https://rt.cpan.org/Ticket/Display.html?id=46203) version: 0.10 date: 2008-02-11 # minor feature addition new: find_nodes_as_strings method which returns a list of strings new: findvalues method which returns a list of values new: as_XML_compact method, a replacement for HTML::TreeBuilder as_XML new: as_XML_indented method, same as as_XML_compact, except indents the output version: 0.09 date: 2007-11-20 # 2 bug fixes fix: added support for the id function, see RT #30792 at https://rt.cpan.org/Ticket/Display.html?id=30792 bug reported, and a fix proposed by tokuhirom fix: a bug where the as_XML method on text nodes returned non escaped text, spotted by Tatsuhiko Miyagawa at the moment the output is quite ugly, as ugly as HTML::Element as_XM. version: 0.08 date: 2007-01-20 # bug fixes fix: a bug that prevented the 'following' and 'preceding' axis to work fix: set version dependency with XML::XPathEngine version: 0.07 date: 2007-01-05 # bug fix fix: a bug that prevented the 'following' axis to be used version: 0.06 date: 2006-08-07 # bug fix fix: a bug that caused a crash when an element had a value of 0 (patch by Martin Sarfy) version: 0.05 date: 2006-05-17 # more tests tests: added pod and pod coverage tests version: 0.04 date: 2006-05-15 # extended perl version support fix: changed the required version of perl from 5.8.4 to 5.6.0 version: 0.03 date: 2006-04-20 # bug fix fix: bug that caused results not to be ordered properly when there were more than 10 results (cf RT #18705) spotted by rnapier version: 0.02 date: 2006-02-27 # bug fix fix: dependency to XML::XPathEngine in the Makefile version: 0.01 date: 2006-02-15 new: original version; created by h2xs 1.23 with options -A -X -nHTML::TreeBuilder::XPath --use-new-tests --skip-exporter --skip-autoloader HTML-TreeBuilder-XPath-0.14/README0000644000175000017500000000120411635765325016564 0ustar mrodrigumrodriguHTML-TreeBuilder-XPath =================================== Extension to HTML::TreeBuilder that adds an XPath engine to HTML::TreeBuilder 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: HTML::TreeBuilder XML::XPathEngine COPYRIGHT AND LICENCE Copyright (C) 2006-2011 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. HTML-TreeBuilder-XPath-0.14/META.yml0000644000175000017500000000106611635767033017161 0ustar mrodrigumrodrigu--- abstract: 'add XPath support to HTML::TreeBuilder' author: - 'Michel Rodriguez ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.58, CPAN::Meta::Converter version 2.110930001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: HTML-TreeBuilder-XPath no_index: directory: - t - inc requires: HTML::TreeBuilder: 0 List::Util: 0 XML::XPathEngine: 0.12 version: 0.14 HTML-TreeBuilder-XPath-0.14/META.json0000644000175000017500000000172211635767033017330 0ustar mrodrigumrodrigu{ "abstract" : "add XPath support to HTML::TreeBuilder", "author" : [ "Michel Rodriguez " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.58, CPAN::Meta::Converter version 2.110930001", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "HTML-TreeBuilder-XPath", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "runtime" : { "requires" : { "HTML::TreeBuilder" : 0, "List::Util" : 0, "XML::XPathEngine" : "0.12" } } }, "release_status" : "stable", "version" : "0.14" }