File Coverage

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

linestmtbrancondsubpodtimecode
1# $Id: /xmltwig/trunk/Twig/XPath.pm 32 2008-01-18T13:11:52.128782Z mrodrigu $
2package XML::Twig::XPath;
3
36
36
36
36
1323
257
758
use strict;
4
36
36
36
36
1278
360
1861
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
870
  { foreach my $xpath_engine ( qw( XML::XPathEngine XML::XPath) )
10
36
36
36
50
1325
732
464
      { if( XML::Twig::_use( $xpath_engine) ) { $XPATH= $xpath_engine; last; } }
11
36
0
50
975
0
    unless( $XPATH) { die "cannot use XML::XPath or XML::XPathEngine: $!"; }
12
36
834
    $XPATH_NUMBER= "${XPATH}::Number";
13  }
14
15
16
36
36
36
36
1760
3721
895
use vars qw($VERSION);
17$VERSION="0.02";
18
19BEGIN
20
36
36
486
{ package XML::XPath::NodeSet;
21
36
36
36
36
945
302
891
  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
971
287
872
  no warnings; # to avoid the "Subroutine sort redefined" message
31  # replace the native sort routine by a Twig'd one
32  sub sort
33
145
145
250609
    { my $self = CORE::shift;
34
145
538
2068
21068
      @$self = CORE::sort { $a->node_cmp( $b) } @$self;
35
145
4886
      return $self;
36    }
37}
38
39package XML::Twig::XPath;
40
41
36
36
36
36
947
273
1189
use base 'XML::Twig';
42
43
1
1
0
40
sub to_number { return $XPATH_NUMBER->new( $_[0]->root->text); }
44
45sub new
46
61
61
1
24009
  { my $class= shift;
47
61
2432
    my $t= XML::Twig->new( elt_class => 'XML::Twig::XPath::Elt', @_);
48
61
1649
    $t->{twig_xp}= $XPATH->new();
49
61
30582
    bless $t, $class;
50
61
2296
    return $t;
51  }
52
53
54
5
5
5
0
1584
124
sub set_namespace { my $t= shift; $t->{twig_xp}->set_namespace( @_); }
55
2
2
2
0
1675
48
sub set_strict_namespaces { my $t= shift; $t->{twig_xp}->set_strict_namespaces( @_); }
56
57
4
100
4
0
113
sub node_cmp($$) { return $_[1] == $_[0] ? 0 : -1; } # document is before anything but itself
58
59
14
14
1
1884
sub isElementNode { 0 }
60
1
1
0
16
sub isAttributeNode { 0 }
61
1
1
1
16
sub isTextNode { 0 }
62
1
1
1
20
sub isProcessingInstructionNode { 0 }
63
1
1
1
16
sub isPINode { 0 }
64
1
1
1
15
sub isCommentNode { 0 }
65
1
1
0
20
sub isNamespaceNode { 0 }
66
2
2
0
970
sub getAttributes { [] }
67
1
1
0
25
sub getValue { return $_[0]->root->text; }
68
69
84
84
84
1
10364
2356
sub findnodes { my( $t, $path)= @_; return $t->{twig_xp}->findnodes( $path, $t); }
70
1
1
1
1
21
31
sub findnodes_as_string { my( $t, $path)= @_; return $t->{twig_xp}->findnodes_as_string( $path, $t); }
71
17
17
17
1
5995
464
sub findvalue { my( $t, $path)= @_; return $t->{twig_xp}->findvalue( $path, $t); }
72
1
1
1
0
19
21
sub exists { my( $t, $path)= @_; return $t->{twig_xp}->exists( $path, $t); }
73
4
4
4
0
69
98
sub find { my( $t, $path)= @_; return $t->{twig_xp}->find( $path, $t); }
74
1
1
1
50
33
1
0
16
16
25
sub matches { my( $t, $path, $node)= @_; $node ||= $t; return $t->{twig_xp}->matches( $node, $path, $t) || 0; }
75
761;
77
78# adds the appropriate methods to XML::Twig::Elt so XML::XPath can be used as the XPath engine
79package XML::Twig::XPath::Elt;
80
36
36
36
36
1068
332
735
use base 'XML::Twig::Elt';
81
82*getLocalName= *XML::Twig::Elt::local_name;
83*getValue = *XML::Twig::Elt::text;
84
4
4
0
66
sub isAttributeNode { 0 }
85
4
4
0
67
sub isNamespaceNode { 0 }
86
87
3
3
0
79
sub to_number { return $XPATH_NUMBER->new( $_[0]->text); }
88
89sub getAttributes
90
126
126
0
120978
  { my $elt= shift;
91
126
2167
    my $atts= $elt->atts;
92    # alternate, faster but less clean, way
93
126
123
3941
6368
    my @atts= map { bless( { name => $_, value => $atts->{$_}, elt => $elt },
94                           'XML::Twig::XPath::Attribute')
95                  }
96                   sort keys %$atts;
97    # my @atts= map { XML::Twig::XPath::Attribute->new( $elt, $_) } sort keys %$atts;
98
126
100
4317
    return wantarray ? @atts : \@atts;
99  }
100
101sub getNamespace
102
14
14
4122
  { my $elt= shift;
103
14
67
416
    my $prefix= shift() || $elt->ns_prefix;
104
14
50
272
    if( my $expanded= $elt->namespace( $prefix))
105
14
265
      { return XML::Twig::XPath::Namespace->new( $prefix, $expanded); }
106    else
107
0
0
      { return XML::Twig::XPath::Namespace->new( $prefix, ''); }
108  }
109
110sub node_cmp($$)
111
507
507
0
8140
  { my( $a, $b)= @_;
112
507
100
100
100
16711
    if( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Elt'))
113      { # 2 elts, compare them
114
471
10044
        return $a->cmp( $b);
115      }
116    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Attribute'))
117      { # elt <=> att, compare the elt to the att->{elt}
118        # if the elt is the att->{elt} (cmp return 0) then -1, elt is before att
119
34
100
685
        return ($a->cmp( $b->{elt}) ) || -1 ;
120      }
121    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath'))
122      { # elt <=> document, elt is after document
123
1
10
        return 1;
124      }
125    else
126
1
9
      { die "unknown node type ", ref( $b); }
127  }
128
129sub getParentNode
130
115
67
115
28696
  { return $_[0]->_parent
131        || $_[0]->twig;
132  }
133
134
5
5
5
1
116
130
sub findnodes { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findnodes( $path, $elt); }
135
2
2
2
1
35
38
sub findnodes_as_string { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findnodes_as_string( $path, $elt); }
136
9
9
9
1
9528
217
sub findvalue { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findvalue( $path, $elt); }
137
1
1
1
0
19
22
sub exists { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->exists( $path, $elt); }
138
1
1
1
0
16
21
sub find { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->find( $path, $elt); }
139
7
7
100
7
0
109
1320
sub matches { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->matches( $elt, $path, $elt->getParentNode) || 0; }
140
141
1421;
143
144# this package is only used to allow XML::XPath as the XPath engine, otherwise
145# attributes are just attached to their parent element and are not considered objects
146
147package XML::Twig::XPath::Attribute;
148
149sub new
150
1
1
1
20
  { my( $class, $elt, $att)= @_;
151
1
26
    return bless { name => $att, value => $elt->att( $att), elt => $elt }, $class;
152  }
153
154
1
1
0
25
sub getValue { return $_[0]->{value}; }
155
97
97
27948
sub getName { return $_[0]->{name} ; }
156
31
31
31
8423
2113
sub getLocalName { (my $name= $_[0]->{name}) =~ s{^.*:}{}; $name; }
157
56
56
45329
sub string_value { return $_[0]->{value}; }
158
3
3
0
1693
sub to_number { return $XPATH_NUMBER->new( $_[0]->{value}); }
159
1
1
1
16
sub isElementNode { 0 }
160
1
1
0
28
sub isAttributeNode { 1 }
161
1
1
0
16
sub isNamespaceNode { 0 }
162
1
1
1
15
sub isTextNode { 0 }
163
1
1
1
15
sub isProcessingInstructionNode { 0 }
164
1
1
1
16
sub isPINode { 0 }
165
1
1
1
15
sub isCommentNode { 0 }
166
11
11
496
sub toString { return qq{$_[0]->{name}="$_[0]->{value}"}; }
167
168sub getNamespace
169
0
0
0
  { my $att= shift;
170
0
0
    my $prefix= shift();
171
0
0
0
    if( ! defined( $prefix))
172
0
0
0
0
0
      { if($att->{name}=~ m{^(.*):}) { $prefix= $1; }
173
0
0
        else { $prefix=''; }
174      }
175
176
0
0
0
    if( my $expanded= $att->{elt}->namespace( $prefix))
177
0
0
      { return XML::Twig::XPath::Namespace->new( $prefix, $expanded); }
178  }
179
180sub node_cmp($$)
181
40
40
0
526
  { my( $a, $b)= @_;
182
40
100
100
100
1469
    if( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Attribute'))
183      { # 2 attributes, compare their elements, then their name
184
17
100
402
        return ($a->{elt}->cmp( $b->{elt}) ) || ($a->{name} cmp $b->{name});
185      }
186    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Elt'))
187      { # att <=> elt : compare the att->elt and the elt
188        # if att->elt is the elt (cmp returns 0) then 1 (elt is before att)
189
20
100
418
        return ($a->{elt}->cmp( $b) ) || 1 ;
190      }
191    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath'))
192      { # att <=> document, att is after document
193
2
48
        return 1;
194      }
195    else
196
1
10
      { die "unknown node type ", ref( $b); }
197  }
198
199*cmp=*node_cmp;
200
2011;
202
203package XML::Twig::XPath::Namespace;
204
205sub new
206
15
15
1
238
  { my( $class, $prefix, $expanded)= @_;
207
15
640
    bless { prefix => $prefix, expanded => $expanded }, $class;
208  }
209
210
1
1
0
21
sub isNamespaceNode { 1; }
211
212
1
1
26
sub getPrefix { $_[0]->{prefix}; }
213
1
1
26
sub getExpanded { $_[0]->{expanded}; }
214
15
15
0
337
sub getValue { $_[0]->{expanded}; }
215
1
1
27
sub getData { $_[0]->{expanded}; }
216
2171
218