# $Id: XPath.pm,v 1.15 2005/07/05 10:47:19 mrodrigu Exp $
package XML::Twig::XPath;
use XML::Twig;
use XML::XPath;

use strict;

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

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::Twig::XPath;

use base 'XML::Twig';

sub to_number { return XML::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}= XML::XPath->new();
		bless $t;
		return $t;
  }

	
sub node_cmp($$)       { return $_[1] == $_[0] ? 0 : -1; } # document is before anything but itself
sub set_namespace      { my $t= shift; $t->{twig_xp}->set_namespace( @_); }
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)= @_; return $t->{twig_xp}->matches( $t, $path, $t); }

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 XML::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); }


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 XML::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); }
  }

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

