/usr/lib/perl5/XML/LibXML/XPathContext.pm is in libxml-libxml-perl 1.89+dfsg-1ubuntu0.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 | # $Id: XPathContext.pm 422 2002-11-08 17:10:30Z phish $
#
# This is free software, you may use it and distribute it under the same terms as
# Perl itself.
#
# Copyright 2001-2003 AxKit.com Ltd., 2002-2006 Christian Glahn, 2006-2009 Petr Pajas
#
#
package XML::LibXML::XPathContext;
use strict;
use vars qw($VERSION @ISA $USE_LIBXML_DATA_TYPES);
use Carp;
use XML::LibXML;
use XML::LibXML::NodeList;
$VERSION = "1.89"; # VERSION TEMPLATE: DO NOT CHANGE
# should LibXML XPath data types be used for simple objects
# when passing parameters to extension functions (default: no)
$USE_LIBXML_DATA_TYPES = 0;
sub CLONE_SKIP { 1 }
sub findnodes {
my ($self, $xpath, $node) = @_;
my @nodes = $self->_guarded_find_call('_findnodes', $node, $xpath);
if (wantarray) {
return @nodes;
}
else {
return XML::LibXML::NodeList->new(@nodes);
}
}
sub find {
my ($self, $xpath, $node) = @_;
my ($type, @params) = $self->_guarded_find_call('_find', $node, $xpath,0);
if ($type) {
return $type->new(@params);
}
return undef;
}
sub exists {
my ($self, $xpath, $node) = @_;
my (undef, $value) = $self->_guarded_find_call('_find', $node, $xpath,1);
return $value;
}
sub findvalue {
my $self = shift;
return $self->find(@_)->to_literal->value;
}
sub _guarded_find_call {
my ($self, $method, $node)=(shift,shift,shift);
my $prev_node;
if (ref($node)) {
$prev_node = $self->getContextNode();
$self->setContextNode($node);
}
my @ret;
eval {
@ret = $self->$method(@_);
};
$self->_free_node_pool;
$self->setContextNode($prev_node) if ref($node);
if ($@) {
my $err = $@;
chomp $err;
croak $err;
}
return @ret;
}
sub registerFunction {
my ($self, $name, $sub) = @_;
$self->registerFunctionNS($name, undef, $sub);
return;
}
sub unregisterNs {
my ($self, $prefix) = @_;
$self->registerNs($prefix, undef);
return;
}
sub unregisterFunction {
my ($self, $name) = @_;
$self->registerFunctionNS($name, undef, undef);
return;
}
sub unregisterFunctionNS {
my ($self, $name, $ns) = @_;
$self->registerFunctionNS($name, $ns, undef);
return;
}
sub unregisterVarLookupFunc {
my ($self) = @_;
$self->registerVarLookupFunc(undef, undef);
return;
}
# extension function perl dispatcher
# borrowed from XML::LibXSLT
sub _perl_dispatcher {
my $func = shift;
my @params = @_;
my @perlParams;
my $i = 0;
while (@params) {
my $type = shift(@params);
if ($type eq 'XML::LibXML::Literal' or
$type eq 'XML::LibXML::Number' or
$type eq 'XML::LibXML::Boolean')
{
my $val = shift(@params);
unshift(@perlParams, $USE_LIBXML_DATA_TYPES ? $type->new($val) : $val);
}
elsif ($type eq 'XML::LibXML::NodeList') {
my $node_count = shift(@params);
unshift(@perlParams, $type->new(splice(@params, 0, $node_count)));
}
}
$func = "main::$func" unless ref($func) || $func =~ /(.+)::/;
no strict 'refs';
my $res = $func->(@perlParams);
return $res;
}
1;
|