This file is indexed.

/usr/share/perl5/XML/Twig/XPath.pm is in libxml-twig-perl 1:3.44-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
# $Id: /xmltwig/trunk/Twig/XPath.pm 32 2008-01-18T13:11:52.128782Z mrodrigu  $
package XML::Twig::XPath;
use strict;
use XML::Twig;

my $XPATH;        # XPath engine (XML::XPath or XML::XPathEngine);
my $XPATH_NUMBER; # <$XPATH>::Number, the XPath number class  
BEGIN 
  { foreach my $xpath_engine ( qw( XML::XPathEngine XML::XPath) )
      { if(  XML::Twig::_use( $xpath_engine) ) { $XPATH= $xpath_engine; last; } }
    unless( $XPATH) { die "cannot use XML::Twig::XPath: neither XML::XPathEngine 0.09+ nor XML::XPath are available"; }
    $XPATH_NUMBER= "${XPATH}::Number";
  }


use vars qw($VERSION);
$VERSION="0.02";

BEGIN
{ package XML::XPath::NodeSet;
  no warnings; # to avoid the "Subroutine sort redefined" message 
  # replace the native sort routine by a Twig'd one
  sub sort 
    { my $self = CORE::shift;
      @$self = CORE::sort { $a->node_cmp( $b) } @$self;
      return $self;
    }

  package XML::XPathEngine::NodeSet;
  no warnings; # to avoid the "Subroutine sort redefined" message 
  # replace the native sort routine by a Twig'd one
  sub sort 
    { my $self = CORE::shift;
      @$self = CORE::sort { $a->node_cmp( $b) } @$self;
      return $self;
    }
}

package XML::Twig::XPath;

use base 'XML::Twig';

sub to_number { return $XPATH_NUMBER->new( $_[0]->root->text); }

sub new
  { my $class= shift;
    my $t= XML::Twig->new( elt_class => 'XML::Twig::XPath::Elt', @_);
    $t->{twig_xp}= $XPATH->new();
    bless $t, $class;
    return $t;
  }


sub set_namespace         { my $t= shift; $t->{twig_xp}->set_namespace( @_); }
sub set_strict_namespaces { my $t= shift; $t->{twig_xp}->set_strict_namespaces( @_); }

sub node_cmp($$)          { return $_[1] == $_[0] ? 0 : -1; } # document is before anything but itself

sub isElementNode   { 0 }
sub isAttributeNode { 0 }
sub isTextNode      { 0 }
sub isProcessingInstructionNode { 0 }
sub isPINode        { 0 }
sub isCommentNode   { 0 }
sub isNamespaceNode { 0 }
sub getAttributes   { [] }
sub getValue { return $_[0]->root->text; }

sub findnodes           { my( $t, $path)= @_; return $t->{twig_xp}->findnodes(           $path, $t); }
sub findnodes_as_string { my( $t, $path)= @_; return $t->{twig_xp}->findnodes_as_string( $path, $t); }
sub findvalue           { my( $t, $path)= @_; return $t->{twig_xp}->findvalue(           $path, $t); }
sub exists              { my( $t, $path)= @_; return $t->{twig_xp}->exists(              $path, $t); }
sub find                { my( $t, $path)= @_; return $t->{twig_xp}->find(                $path, $t); }
sub matches             { my( $t, $path, $node)= @_; $node ||= $t; return $t->{twig_xp}->matches( $node, $path, $t) || 0; }

1;

# adds the appropriate methods to XML::Twig::Elt so XML::XPath can be used as the XPath engine
package XML::Twig::XPath::Elt;
use base 'XML::Twig::Elt';

*getLocalName= *XML::Twig::Elt::local_name;
*getValue    = *XML::Twig::Elt::text;
sub isAttributeNode { 0 }
sub isNamespaceNode { 0 }

sub to_number { return $XPATH_NUMBER->new( $_[0]->text); }

sub getAttributes
  { my $elt= shift;
    my $atts= $elt->atts;
    # alternate, faster but less clean, way
    my @atts= map { bless( { name => $_, value => $atts->{$_}, elt => $elt }, 
                           'XML::Twig::XPath::Attribute') 
                  }
                   sort keys %$atts; 
    # my @atts= map { XML::Twig::XPath::Attribute->new( $elt, $_) } sort keys %$atts; 
    return wantarray ? @atts : \@atts;
  }

sub getNamespace
  { my $elt= shift;
    my $prefix= shift() || $elt->ns_prefix;
    if( my $expanded= $elt->namespace( $prefix))
      { return XML::Twig::XPath::Namespace->new( $prefix, $expanded); }
    else
      { return XML::Twig::XPath::Namespace->new( $prefix, ''); }
  }

sub node_cmp($$) 
  { my( $a, $b)= @_;
    if( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Elt')) 
      { # 2 elts, compare them
        return $a->cmp( $b);
      }
    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Attribute'))
      { # elt <=> att, compare the elt to the att->{elt}
        # if the elt is the att->{elt} (cmp return 0) then -1, elt is before att
        return ($a->cmp( $b->{elt}) ) || -1 ;
      }
    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath'))
      { # elt <=> document, elt is after document
        return 1;
      } 
    else
      { die "unknown node type ", ref( $b); }
  }

sub getParentNode
  { return $_[0]->_parent 
        || $_[0]->twig;
  }
  
sub findnodes           { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findnodes(           $path, $elt); }
sub findnodes_as_string { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findnodes_as_string( $path, $elt); }
sub findvalue           { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findvalue(           $path, $elt); }
sub exists              { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->exists(              $path, $elt); }
sub find                { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->find(                $path, $elt); }
sub matches             { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->matches( $elt, $path, $elt->getParentNode) || 0; }


1;

# this package is only used to allow XML::XPath as the XPath engine, otherwise
# attributes are just attached to their parent element and are not considered objects

package XML::Twig::XPath::Attribute;

sub new
  { my( $class, $elt, $att)= @_;
    return bless { name => $att, value => $elt->att( $att), elt => $elt }, $class;
  }

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 $XPATH_NUMBER->new( $_[0]->{value}); }
sub isElementNode   { 0 }
sub isAttributeNode { 1 }
sub isNamespaceNode { 0 }
sub isTextNode      { 0 }
sub isProcessingInstructionNode { 0 }
sub isPINode        { 0 }
sub isCommentNode   { 0 }
sub toString { return qq{$_[0]->{name}="$_[0]->{value}"}; }

sub getNamespace
  { my $att= shift;
    my $prefix= shift();
    if( ! defined( $prefix))
      { if($att->{name}=~ m{^(.*):}) { $prefix= $1; }
        else                         { $prefix='';  }
      }

    if( my $expanded= $att->{elt}->namespace( $prefix))
      { return XML::Twig::XPath::Namespace->new( $prefix, $expanded); }
  }

sub node_cmp($$) 
  { my( $a, $b)= @_;
    if( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Attribute')) 
      { # 2 attributes, compare their elements, then their name 
        return ($a->{elt}->cmp( $b->{elt}) ) || ($a->{name} cmp $b->{name});
      }
    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Elt'))
      { # att <=> elt : compare the att->elt and the elt
        # if att->elt is the elt (cmp returns 0) then 1 (elt is before att)
        return ($a->{elt}->cmp( $b) ) || 1 ;
      }
    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath'))
      { # att <=> document, att is after document 
        return 1;
      }
    else
      { die "unknown node type ", ref( $b); }
  }

*cmp=*node_cmp;
  
1;

package XML::Twig::XPath::Namespace;

sub new
  { my( $class, $prefix, $expanded)= @_;
    bless { prefix => $prefix, expanded => $expanded }, $class;
  }

sub isNamespaceNode { 1; }

sub getPrefix   { $_[0]->{prefix};   }
sub getExpanded { $_[0]->{expanded}; }
sub getValue    { $_[0]->{expanded}; }
sub getData     { $_[0]->{expanded}; }

1