File Coverage

File:blib/lib/XML/Twig/XPath.pm
Coverage:87.4%

linestmtbrancondsubpodtimecode
1# $Id: /xmltwig/trunk/Twig/XPath.pm 4 2007-03-16T12:16:25.259192Z mrodrigu $
2package XML::Twig::XPath;
3
36
36
36
36
1107
205
1065
use strict;
4
36
36
36
36
1007
602
2703
use XML::Twig;
5
6my $XPATH; # XPath engine (XML::XPath or XML::XPathEngine);
7my $XPATH_NUMBER; # <$XPATH>::Number, the XPath number class
8BEGIN
9
36
36
814
  { foreach my $xpath_engine ( qw( XML::XPathEngine XML::XPath) )
10
36
36
36
50
650
509
426
      { if( XML::Twig::_use( $xpath_engine) ) { $XPATH= $xpath_engine; last; } }
11
36
0
50
873
0
    unless( $XPATH) { die "cannot use XML::XPath or XML::XPathEngine: $!"; }
12
36
531
    $XPATH_NUMBER= "${XPATH}::Number";
13  }
14
15
16
36
36
36
36
1100
1813
872
use vars qw($VERSION);
17$VERSION="0.02";
18
19BEGIN
20
36
36
501
{ package XML::XPath::NodeSet;
21
36
36
36
36
1431
493
770
  no warnings; # to avoid the "Subroutine sort redefined" message
22        # replace the native sort routine by a Twig'd one
23  sub sort
24
0
0
0
    { my $self = CORE::shift;
25
0
0
0
0
      @$self = CORE::sort { $a->node_cmp( $b) } @$self;
26
0
0
      return $self;
27    }
28
29  package XML::XPathEngine::NodeSet;
30
36
36
36
36
860
263
592
  no warnings; # to avoid the "Subroutine sort redefined" message
31        # replace the native sort routine by a Twig'd one
32  sub sort
33
140
140
163964
    { my $self = CORE::shift;
34
140
550
1663
14527
      @$self = CORE::sort { $a->node_cmp( $b) } @$self;
35
140
6073
      return $self;
36    }
37}
38
39package XML::Twig::XPath;
40
41
36
36
36
36
876
237
1105
use base 'XML::Twig';
42
43
1
1
0
37
sub to_number { return $XPATH_NUMBER->new( $_[0]->root->text); }
44
45sub new
46
57
57
1
22735
  { my $class= shift;
47
57
2208
                my $t= XML::Twig->new( elt_class => 'XML::Twig::XPath::Elt', @_);
48
57
2751
    $t->{twig_xp}= $XPATH->new();
49
57
30995
                bless $t;
50
57
1658
                return $t;
51  }
52
53
54
4
100
4
0
114
sub node_cmp($$) { return $_[1] == $_[0] ? 0 : -1; } # document is before anything but itself
55
2
2
2
0
21
45
sub set_namespace { my $t= shift; $t->{twig_xp}->set_namespace( @_); }
56
14
14
1
2159
sub isElementNode { 0 }
57
1
1
0
20
sub isAttributeNode { 0 }
58
1
1
1
15
sub isTextNode { 0 }
59
1
1
1
15
sub isProcessingInstructionNode { 0 }
60
1
1
1
16
sub isPINode { 0 }
61
1
1
1
15
sub isCommentNode { 0 }
62
1
1
0
16
sub isNamespaceNode { 0 }
63
2
2
0
695
sub getAttributes { [] }
64
1
1
0
20
sub getValue { return $_[0]->root->text; }
65
66
84
84
84
1
1908
2061
sub findnodes { my( $t, $path)= @_; return $t->{twig_xp}->findnodes( $path, $t); }
67
1
1
1
1
16
26
sub findnodes_as_string { my( $t, $path)= @_; return $t->{twig_xp}->findnodes_as_string( $path, $t); }
68
12
12
12
1
194
289
sub findvalue { my( $t, $path)= @_; return $t->{twig_xp}->findvalue( $path, $t); }
69
1
1
1
0
15
21
sub exists { my( $t, $path)= @_; return $t->{twig_xp}->exists( $path, $t); }
70
4
4
4
0
70
101
sub find { my( $t, $path)= @_; return $t->{twig_xp}->find( $path, $t); }
71
1
1
1
50
33
1
0
17
15
46
sub matches { my( $t, $path, $node)= @_; $node ||= $t; return $t->{twig_xp}->matches( $node, $path, $t) || 0; }
72
731;
74
75# adds the appropriate methods to XML::Twig::Elt so XML::XPath can be used as the XPath engine
76package XML::Twig::XPath::Elt;
77
36
36
36
36
1767
251
1796
use base 'XML::Twig::Elt';
78
79*getLocalName= *XML::Twig::Elt::local_name;
80*getValue = *XML::Twig::Elt::text;
81
4
4
0
59
sub isAttributeNode { 0 }
82
4
4
0
58
sub isNamespaceNode { 0 }
83
84
3
3
0
73
sub to_number { return $XPATH_NUMBER->new( $_[0]->text); }
85
86sub getAttributes
87
126
126
0
75548
  { my $elt= shift;
88
126
2487
    my $atts= $elt->atts;
89                # alternate, faster but less clean, way
90
126
123
4244
6602
                my @atts= map { bless( { name => $_, value => $atts->{$_}, elt => $elt },
91                                       'XML::Twig::XPath::Attribute')
92                              }
93                               sort keys %$atts;
94                # my @atts= map { XML::Twig::XPath::Attribute->new( $elt, $_) } sort keys %$atts;
95
126
100
3983
    return wantarray ? @atts : \@atts;
96  }
97
98sub getNamespace
99
114
114
14522
  { my $elt= shift;
100
114
100
2555
          my $prefix= shift() || $elt->ns_prefix;
101
114
100
1868
                if( my $expanded= $elt->namespace( $prefix))
102
80
1332
                  { return XML::Twig::XPath::Namespace->new( $prefix, $expanded); }
103                else
104
34
594
                  { return XML::Twig::XPath::Namespace->new( $prefix, ''); }
105  }
106
107sub node_cmp($$)
108
508
508
0
7263
  { my( $a, $b)= @_;
109
508
100
100
100
12852
    if( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Elt'))
110      { # 2 elts, compare them
111
476
17053
                                return $a->cmp( $b);
112            }
113    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Attribute'))
114      { # elt <=> att, compare the elt to the att->{elt}
115                                # if the elt is the att->{elt} (cmp return 0) then -1, elt is before att
116
30
100
558
        return ($a->cmp( $b->{elt}) ) || -1 ;
117      }
118    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath'))
119      { # elt <=> document, elt is after document
120
1
7
                                return 1;
121      }
122    else
123
1
6
      { die "unknown node type ", ref( $b); }
124  }
125
126sub getParentNode
127
115
67
115
14985
  { return $_[0]->_parent
128        || $_[0]->twig;
129  }
130
131
5
5
5
1
114
102
sub findnodes { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findnodes( $path, $elt); }
132
2
2
2
1
30
37
sub findnodes_as_string { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findnodes_as_string( $path, $elt); }
133
9
9
9
1
5807
470
sub findvalue { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findvalue( $path, $elt); }
134
1
1
1
0
16
20
sub exists { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->exists( $path, $elt); }
135
1
1
1
0
17
20
sub find { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->find( $path, $elt); }
136
7
7
100
7
0
94
119
sub matches { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->matches( $elt, $path, $elt->getParentNode) || 0; }
137
138
1391;
140
141# this package is only used to allow XML::XPath as the XPath engine, otherwise
142# attributes are just attached to their parent element and are not considered objects
143
144package XML::Twig::XPath::Attribute;
145
146sub new
147
1
1
1
20
  { my( $class, $elt, $att)= @_;
148
1
37
    return bless { name => $att, value => $elt->att( $att), elt => $elt }, $class;
149        }
150
151
1
1
0
23
sub getValue { return $_[0]->{value}; }
152
74
74
13941
sub getName { return $_[0]->{name} ; }
153
20
20
20
545
883
sub getLocalName { (my $name= $_[0]->{name}) =~ s{^.*:}{}; $name; }
154
56
56
39748
sub string_value { return $_[0]->{value}; }
155
3
3
0
1855
sub to_number { return $XPATH_NUMBER->new( $_[0]->{value}); }
156
1
1
1
19
sub isElementNode { 0 }
157
1
1
0
31
sub isAttributeNode { 1 }
158
1
1
0
12
sub isNamespaceNode { 0 }
159
1
1
1
16
sub isTextNode { 0 }
160
1
1
1
15
sub isProcessingInstructionNode { 0 }
161
1
1
1
15
sub isPINode { 0 }
162
1
1
1
16
sub isCommentNode { 0 }
163
11
11
520
sub toString { return qq{$_[0]->{name}="$_[0]->{value}"}; }
164
165sub getNamespace
166
62
62
11039
  { my $att= shift;
167
62
641
          my $prefix= shift();
168
62
100
885
                if( ! defined( $prefix))
169
31
27
100
705
433
            { if($att->{name}=~ m{^(.*):}) { $prefix= $1; }
170
4
58
                    else { $prefix=''; }
171      }
172
173
62
100
1199
                if( my $expanded= $att->{elt}->namespace( $prefix))
174
54
1250
                  { return XML::Twig::XPath::Namespace->new( $prefix, $expanded); }
175  }
176
177sub node_cmp($$)
178
51
51
0
657
  { my( $a, $b)= @_;
179
51
100
100
100
1678
    if( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Attribute'))
180      { # 2 attributes, compare their elements, then their name
181
25
100
556
        return ($a->{elt}->cmp( $b->{elt}) ) || ($a->{name} cmp $b->{name});
182      }
183    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Elt'))
184      { # att <=> elt : compare the att->elt and the elt
185        # if att->elt is the elt (cmp returns 0) then 1 (elt is before att)
186
23
100
445
        return ($a->{elt}->cmp( $b) ) || 1 ;
187      }
188    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath'))
189      { # att <=> document, att is after document
190
2
31
        return 1;
191      }
192    else
193
1
10
      { die "unknown node type ", ref( $b); }
194  }
195
196*cmp=*node_cmp;
197
1981;
199
200package XML::Twig::XPath::Namespace;
201
202sub new
203
169
169
1
2776
  { my( $class, $prefix, $expanded)= @_;
204
169
7707
                bless { prefix => $prefix, expanded => $expanded }, $class;
205        }
206
207
1
1
0
15
sub isNamespaceNode { 1; }
208
209
1
1
25
sub getPrefix { $_[0]->{prefix}; }
210
1
1
25
sub getExpanded { $_[0]->{expanded}; }
211
169
169
0
11426
sub getValue { $_[0]->{expanded}; }
212
1
1
25
sub getData { $_[0]->{expanded}; }
213
2141
215