home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / XML / Twig / XPath.pm
Encoding:
Perl POD Document  |  2009-04-14  |  7.0 KB  |  216 lines
  1. # $Id: /xmltwig/trunk/Twig/XPath.pm 4 2007-03-16T12:16:25.259192Z mrodrigu  $
  2. package XML::Twig::XPath;
  3. use strict;
  4. use XML::Twig;
  5.  
  6. my $XPATH;        # XPath engine (XML::XPath or XML::XPathEngine);
  7. my $XPATH_NUMBER; # <$XPATH>::Number, the XPath number class  
  8. BEGIN 
  9.   { foreach my $xpath_engine ( qw( XML::XPathEngine XML::XPath) )
  10.       { if(  XML::Twig::_use( $xpath_engine) ) { $XPATH= $xpath_engine; last; } }
  11.     unless( $XPATH) { die "cannot use XML::XPath or XML::XPathEngine: $!"; }
  12.     $XPATH_NUMBER= "${XPATH}::Number";
  13.   }
  14.  
  15.  
  16. use vars qw($VERSION);
  17. $VERSION="0.02";
  18.  
  19. BEGIN
  20. { package XML::XPath::NodeSet;
  21.   no warnings; # to avoid the "Subroutine sort redefined" message 
  22.     # replace the native sort routine by a Twig'd one
  23.   sub sort 
  24.     { my $self = CORE::shift;
  25.       @$self = CORE::sort { $a->node_cmp( $b) } @$self;
  26.       return $self;
  27.     }
  28.  
  29.   package XML::XPathEngine::NodeSet;
  30.   no warnings; # to avoid the "Subroutine sort redefined" message 
  31.     # replace the native sort routine by a Twig'd one
  32.   sub sort 
  33.     { my $self = CORE::shift;
  34.       @$self = CORE::sort { $a->node_cmp( $b) } @$self;
  35.       return $self;
  36.     }
  37. }
  38.  
  39. package XML::Twig::XPath;
  40.  
  41. use base 'XML::Twig';
  42.  
  43. sub to_number { return $XPATH_NUMBER->new( $_[0]->root->text); }
  44.  
  45. sub new
  46.   { my $class= shift;
  47.         my $t= XML::Twig->new( elt_class => 'XML::Twig::XPath::Elt', @_);
  48.     $t->{twig_xp}= $XPATH->new();
  49.         bless $t;
  50.         return $t;
  51.   }
  52.  
  53.     
  54. sub node_cmp($$)       { return $_[1] == $_[0] ? 0 : -1; } # document is before anything but itself
  55. sub set_namespace      { my $t= shift; $t->{twig_xp}->set_namespace( @_); }
  56. sub isElementNode   { 0 }
  57. sub isAttributeNode { 0 }
  58. sub isTextNode      { 0 }
  59. sub isProcessingInstructionNode { 0 }
  60. sub isPINode        { 0 }
  61. sub isCommentNode   { 0 }
  62. sub isNamespaceNode { 0 }
  63. sub getAttributes   { [] }
  64. sub getValue { return $_[0]->root->text; }
  65.  
  66. sub findnodes           { my( $t, $path)= @_; return $t->{twig_xp}->findnodes(           $path, $t); }
  67. sub findnodes_as_string { my( $t, $path)= @_; return $t->{twig_xp}->findnodes_as_string( $path, $t); }
  68. sub findvalue           { my( $t, $path)= @_; return $t->{twig_xp}->findvalue(           $path, $t); }
  69. sub exists              { my( $t, $path)= @_; return $t->{twig_xp}->exists(              $path, $t); }
  70. sub find                { my( $t, $path)= @_; return $t->{twig_xp}->find(                $path, $t); }
  71. sub matches             { my( $t, $path, $node)= @_; $node ||= $t; return $t->{twig_xp}->matches( $node, $path, $t) || 0; }
  72.  
  73. 1;
  74.  
  75. # adds the appropriate methods to XML::Twig::Elt so XML::XPath can be used as the XPath engine
  76. package XML::Twig::XPath::Elt;
  77. use base 'XML::Twig::Elt';
  78.  
  79. *getLocalName= *XML::Twig::Elt::local_name;
  80. *getValue    = *XML::Twig::Elt::text;
  81. sub isAttributeNode { 0 }
  82. sub isNamespaceNode { 0 }
  83.  
  84. sub to_number { return $XPATH_NUMBER->new( $_[0]->text); }
  85.  
  86. sub getAttributes
  87.   { my $elt= shift;
  88.     my $atts= $elt->atts;
  89.         # alternate, faster but less clean, way
  90.         my @atts= map { bless( { name => $_, value => $atts->{$_}, elt => $elt }, 
  91.                                'XML::Twig::XPath::Attribute') 
  92.                       }
  93.                        sort keys %$atts; 
  94.         # my @atts= map { XML::Twig::XPath::Attribute->new( $elt, $_) } sort keys %$atts; 
  95.     return wantarray ? @atts : \@atts;
  96.   }
  97.  
  98. sub getNamespace
  99.   { my $elt= shift;
  100.       my $prefix= shift() || $elt->ns_prefix;
  101.         if( my $expanded= $elt->namespace( $prefix))
  102.           { return XML::Twig::XPath::Namespace->new( $prefix, $expanded); }
  103.         else
  104.           { return XML::Twig::XPath::Namespace->new( $prefix, ''); }
  105.   }
  106.  
  107. sub node_cmp($$) 
  108.   { my( $a, $b)= @_;
  109.     if( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Elt')) 
  110.       { # 2 elts, compare them
  111.                 return $a->cmp( $b);
  112.         }
  113.     elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Attribute'))
  114.       { # elt <=> att, compare the elt to the att->{elt}
  115.                 # if the elt is the att->{elt} (cmp return 0) then -1, elt is before att
  116.         return ($a->cmp( $b->{elt}) ) || -1 ;
  117.       }
  118.     elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath'))
  119.       { # elt <=> document, elt is after document
  120.                 return 1;
  121.       } 
  122.     else
  123.       { die "unknown node type ", ref( $b); }
  124.   }
  125.  
  126. sub getParentNode
  127.   { return $_[0]->_parent 
  128.         || $_[0]->twig;
  129.   }
  130.     
  131. sub findnodes           { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findnodes(           $path, $elt); }
  132. sub findnodes_as_string { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findnodes_as_string( $path, $elt); }
  133. sub findvalue           { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->findvalue(           $path, $elt); }
  134. sub exists              { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->exists(              $path, $elt); }
  135. sub find                { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->find(                $path, $elt); }
  136. sub matches             { my( $elt, $path)= @_; return $elt->twig->{twig_xp}->matches( $elt, $path, $elt->getParentNode) || 0; }
  137.  
  138.  
  139. 1;
  140.  
  141. # this package is only used to allow XML::XPath as the XPath engine, otherwise
  142. # attributes are just attached to their parent element and are not considered objects
  143.  
  144. package XML::Twig::XPath::Attribute;
  145.  
  146. sub new
  147.   { my( $class, $elt, $att)= @_;
  148.     return bless { name => $att, value => $elt->att( $att), elt => $elt }, $class;
  149.     }
  150.  
  151. sub getValue     { return $_[0]->{value}; }
  152. sub getName      { return $_[0]->{name} ; }
  153. sub getLocalName { (my $name= $_[0]->{name}) =~ s{^.*:}{}; $name; }
  154. sub string_value { return $_[0]->{value}; }
  155. sub to_number    { return $XPATH_NUMBER->new( $_[0]->{value}); }
  156. sub isElementNode   { 0 }
  157. sub isAttributeNode { 1 }
  158. sub isNamespaceNode { 0 }
  159. sub isTextNode      { 0 }
  160. sub isProcessingInstructionNode { 0 }
  161. sub isPINode        { 0 }
  162. sub isCommentNode   { 0 }
  163. sub toString { return qq{$_[0]->{name}="$_[0]->{value}"}; }
  164.  
  165. sub getNamespace
  166.   { my $att= shift;
  167.       my $prefix= shift();
  168.         if( ! defined( $prefix))
  169.         { if($att->{name}=~ m{^(.*):}) { $prefix= $1; }
  170.             else                         { $prefix='';  }
  171.       }
  172.  
  173.         if( my $expanded= $att->{elt}->namespace( $prefix))
  174.           { return XML::Twig::XPath::Namespace->new( $prefix, $expanded); }
  175.   }
  176.  
  177. sub node_cmp($$) 
  178.   { my( $a, $b)= @_;
  179.     if( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Attribute')) 
  180.       { # 2 attributes, compare their elements, then their name 
  181.         return ($a->{elt}->cmp( $b->{elt}) ) || ($a->{name} cmp $b->{name});
  182.       }
  183.     elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath::Elt'))
  184.       { # att <=> elt : compare the att->elt and the elt
  185.         # if att->elt is the elt (cmp returns 0) then 1 (elt is before att)
  186.         return ($a->{elt}->cmp( $b) ) || 1 ;
  187.       }
  188.     elsif( UNIVERSAL::isa( $b, 'XML::Twig::XPath'))
  189.       { # att <=> document, att is after document 
  190.         return 1;
  191.       }
  192.     else
  193.       { die "unknown node type ", ref( $b); }
  194.   }
  195.  
  196. *cmp=*node_cmp;
  197.   
  198. 1;
  199.  
  200. package XML::Twig::XPath::Namespace;
  201.  
  202. sub new
  203.   { my( $class, $prefix, $expanded)= @_;
  204.         bless { prefix => $prefix, expanded => $expanded }, $class;
  205.     }
  206.  
  207. sub isNamespaceNode { 1; }
  208.  
  209. sub getPrefix   { $_[0]->{prefix};   }
  210. sub getExpanded { $_[0]->{expanded}; }
  211. sub getValue    { $_[0]->{expanded}; }
  212. sub getData     { $_[0]->{expanded}; }
  213.  
  214. 1
  215.  
  216.