<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># $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; # &lt;$XPATH&gt;::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 # hide from PAUSE
    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-&gt;node_cmp( $b) } @$self;
      return $self;
    }

  package # hide from PAUSE
    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-&gt;node_cmp( $b) } @$self;
      return $self;
    }
}

package XML::Twig::XPath;

use base 'XML::Twig';

my $XP; # the global xp object;

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

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


sub set_namespace         { my $t= shift; $t-&gt;{twig_xp}-&gt;set_namespace( @_); }
sub set_strict_namespaces { my $t= shift; $t-&gt;{twig_xp}-&gt;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]-&gt;root-&gt;text; }

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

#TODO: it would be nice to be able to pass in any object in this
#distribution and cast it to the proper $XPATH class to use as a
#variable (via 'nodes' argument or something)
sub set_var {
  my ($t, $name, $value) = @_;
  if( ! ref $value) { $value= $t-&gt;findnodes( qq{"$value"}); } 
  $t-&gt;{twig_xp}-&gt;set_var($name, $value);
}

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-&gt;new( $_[0]-&gt;text); }

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

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

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

sub getParentNode
  { return $_[0]-&gt;_parent
        || $_[0]-&gt;twig;
  }

sub findnodes           { my( $elt, $path)= @_; return $elt-&gt;twig-&gt;{twig_xp}-&gt;findnodes(           $path, $elt); }
sub findnodes_as_string { my( $elt, $path)= @_; return $elt-&gt;twig-&gt;{twig_xp}-&gt;findnodes_as_string( $path, $elt); }
sub findvalue           { my( $elt, $path)= @_; return $elt-&gt;twig-&gt;{twig_xp}-&gt;findvalue(           $path, $elt); }
sub exists              { my( $elt, $path)= @_; return $elt-&gt;twig-&gt;{twig_xp}-&gt;exists(              $path, $elt); }
sub find                { my( $elt, $path)= @_; return $elt-&gt;twig-&gt;{twig_xp}-&gt;find(                $path, $elt); }
sub matches             { my( $elt, $path)= @_; return $elt-&gt;twig-&gt;{twig_xp}-&gt;matches( $elt, $path, $elt-&gt;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 =&gt; $att, value =&gt; $elt-&gt;att( $att), elt =&gt; $elt }, $class;
  }

sub getValue     { return $_[0]-&gt;{value}; }
sub getName      { return $_[0]-&gt;{name} ; }
sub getLocalName { (my $name= $_[0]-&gt;{name}) =~ s{^.*:}{}; $name; }
sub string_value { return $_[0]-&gt;{value}; }
sub to_number    { return $XPATH_NUMBER-&gt;new( $_[0]-&gt;{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]-&gt;{name}="$_[0]-&gt;{value}"}; }

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

    if( my $expanded= $att-&gt;{elt}-&gt;namespace( $prefix))
      { return XML::Twig::XPath::Namespace-&gt;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-&gt;{elt}-&gt;cmp( $b-&gt;{elt}) ) || ($a-&gt;{name} cmp $b-&gt;{name});
      }
    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Elt'))
      { # att &lt;=&gt; elt : compare the att-&gt;elt and the elt
        # if att-&gt;elt is the elt (cmp returns 0) then 1 (elt is before att)
        return ($a-&gt;{elt}-&gt;cmp( $b) ) || 1 ;
      }
    elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath'))
      { # att &lt;=&gt; 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 =&gt; $prefix, expanded =&gt; $expanded }, $class;
  }

sub isNamespaceNode { 1; }

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

1

</pre></body></html>