File Coverage

blib/lib/Web/Query/LibXML.pm
Criterion Covered Total %
statement 12 14 85.7
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 17 19 89.4


line stmt bran cond sub pod time code
1             package Web::Query::LibXML;
2             our $AUTHORITY = 'cpan:TOKUHIROM';
3             # ABSTRACT: fast, drop-in replacement for Web::Query
4             $Web::Query::LibXML::VERSION = '0.38';
5              
6 40     40   27237 use 5.008005;
  40         107  
7 40     40   144 use strict;
  40         40  
  40         746  
8 40     40   118 use warnings;
  40         49  
  40         1123  
9 40     40   125 use parent qw/Web::Query Exporter/;
  40         82  
  40         262  
10 40     40   17947 use HTML::TreeBuilder::LibXML;
  0            
  0            
11              
12             # version required for unique_key
13             use XML::LibXML 2.0107;
14              
15             our @EXPORT = qw/wq/;
16              
17             sub wq { Web::Query::LibXML->new(@_) }
18              
19             sub _build_tree {
20             my $tree = HTML::TreeBuilder::LibXML->new();
21             $tree->ignore_unknown(0);
22             $tree->store_comments(1);
23             $tree;
24             }
25              
26             sub _is_same_node {
27             $_[1]->{node}->isSameNode($_[2]->{node});
28             }
29              
30             sub prev {
31             my $self = shift;
32             my @new;
33             for my $tree (@{$self->{trees}}) {
34             push @new, $tree->left;
35             }
36             return (ref $self || $self)->new_from_element(\@new, $self);
37             }
38              
39             sub next {
40             my $self = shift;
41             my @new;
42             for my $tree (@{$self->{trees}}) {
43             push @new, grep { $_ } $tree->right;
44             }
45             return (ref $self || $self)->new_from_element(\@new, $self);
46             }
47              
48             sub tagname {
49             my $self = shift;
50             my $method = @_ ? 'setNodeName' : 'nodeName';
51            
52             my @retval = map { $_->{node}->$method(@_) } @{$self->{trees}};
53             return wantarray ? @retval : $retval[0];
54             }
55              
56             sub _node_id { $_[1]{node}->unique_key }
57             1;
58              
59             __END__