r18641 - in /trunk/libxml-xpathengine-perl: Changes META.yml debian/changelog lib/XML/XPathEngine.pm lib/XML/XPathEngine/Function.pm lib/XML/XPathEngine/NodeSet.pm lib/XML/XPathEngine/Step.pm t/01_basic.t

dmn at users.alioth.debian.org dmn at users.alioth.debian.org
Tue Apr 15 20:03:42 UTC 2008


Author: dmn
Date: Tue Apr 15 20:03:41 2008
New Revision: 18641

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=18641
Log:
another new upstream release

Modified:
    trunk/libxml-xpathengine-perl/Changes
    trunk/libxml-xpathengine-perl/META.yml
    trunk/libxml-xpathengine-perl/debian/changelog
    trunk/libxml-xpathengine-perl/lib/XML/XPathEngine.pm
    trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/Function.pm
    trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/NodeSet.pm
    trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/Step.pm
    trunk/libxml-xpathengine-perl/t/01_basic.t

Modified: trunk/libxml-xpathengine-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpathengine-perl/Changes?rev=18641&op=diff
==============================================================================
--- trunk/libxml-xpathengine-perl/Changes (original)
+++ trunk/libxml-xpathengine-perl/Changes Tue Apr 15 20:03:41 2008
@@ -1,4 +1,13 @@
 Revision history for XML::XPathEngine
+
+version 011
+fix:    axis_descendant returns descendants in incorrect order.
+        found and patched by Kumagai Kentaro
+        http://rt.cpan.org/Ticket/Display.html?id=35049
+
+fix:    calling id() function in some situations causes an error
+        found and patched by Kumagai Kentaro
+        http://rt.cpan.org/Ticket/Display.html?id=35049
 
 version 0.10
 fix:    overloading did not quite work (literals returned by findvalue

Modified: trunk/libxml-xpathengine-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpathengine-perl/META.yml?rev=18641&op=diff
==============================================================================
--- trunk/libxml-xpathengine-perl/META.yml (original)
+++ trunk/libxml-xpathengine-perl/META.yml Tue Apr 15 20:03:41 2008
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                XML-XPathEngine
-version:             0.10
+version:             0.11
 abstract:            a re-usable XPath engine for DOM-like trees
 license:             ~
 author:              

Modified: trunk/libxml-xpathengine-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpathengine-perl/debian/changelog?rev=18641&op=diff
==============================================================================
--- trunk/libxml-xpathengine-perl/debian/changelog (original)
+++ trunk/libxml-xpathengine-perl/debian/changelog Tue Apr 15 20:03:41 2008
@@ -1,10 +1,14 @@
-libxml-xpathengine-perl (0.10-1) unstable; urgency=low
+libxml-xpathengine-perl (0.11-1) UNRELEASED; urgency=low
 
+  [ gregor herrmann ]
   * New upstream release, closes two Debian bugs:
     - stringification overload broken (closes: #460297)
     - "and" in Xpath(Engine) should be commutative (closes: #460281)
 
- -- gregor herrmann <gregor+debian at comodo.priv.at>  Tue, 15 Apr 2008 17:40:10 +0200
+  [ Damyan Ivanov ]
+  * another new upstream release
+
+ -- Damyan Ivanov <dmn at debian.org>  Tue, 15 Apr 2008 22:58:55 +0300
 
 libxml-xpathengine-perl (0.09-1) unstable; urgency=low
 

Modified: trunk/libxml-xpathengine-perl/lib/XML/XPathEngine.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpathengine-perl/lib/XML/XPathEngine.pm?rev=18641&op=diff
==============================================================================
--- trunk/libxml-xpathengine-perl/lib/XML/XPathEngine.pm (original)
+++ trunk/libxml-xpathengine-perl/lib/XML/XPathEngine.pm Tue Apr 15 20:03:41 2008
@@ -5,7 +5,7 @@
 
 use vars qw($VERSION $AUTOLOAD $revision);
 
-$VERSION = '0.10';
+$VERSION = '0.11';
 $XML::XPathEngine::Namespaces = 0;
 $XML::XPathEngine::DEBUG = 0;
 

Modified: trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/Function.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/Function.pm?rev=18641&op=diff
==============================================================================
--- trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/Function.pm (original)
+++ trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/Function.pm Tue Apr 15 20:03:41 2008
@@ -49,7 +49,7 @@
 sub evaluate {
     my $self = shift;
     my $node = shift;
-    if ($node->isa('XML::XPathEngine::NodeSet')) {
+    while ($node->isa('XML::XPathEngine::NodeSet')) {
         $node = $node->get_node(1);
     }
     my @params;
@@ -117,6 +117,10 @@
         my $string = $self->string($node, $params[0]);
         $_ = $string->value; # get perl scalar
         my @ids = split; # splits $_
+        if ($node->isAttributeNode) {
+            warn "calling \($node->getParentNode->getRootNode->getChildNodes)->[0] on attribute node\n";
+            $node = ($node->getParentNode->getRootNode->getChildNodes)->[0];
+        }
         foreach my $id (@ids) {
             if (my $found = $node->getElementById($id)) {
                 $results->push($found);

Modified: trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/NodeSet.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/NodeSet.pm?rev=18641&op=diff
==============================================================================
--- trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/NodeSet.pm (original)
+++ trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/NodeSet.pm Tue Apr 15 20:03:41 2008
@@ -29,14 +29,14 @@
 
 sub remove_duplicates {
     my $self = CORE::shift;
-		my @unique;
-		my $last_node=0;
-		foreach my $node (@$self) { 
-				push @unique, $node unless( $node == $last_node);
-				$last_node= $node;
-		}
-		@$self= @unique; 
-		return $self;
+    my @unique;
+    my $last_node=0;
+    foreach my $node (@$self) { 
+        push @unique, $node unless( $node == $last_node);
+        $last_node= $node;
+    }
+    @$self= @unique; 
+    return $self;
 }
 
 
@@ -95,6 +95,17 @@
 	@$self;
 }
 
+sub getChildNodes {
+    my $self = CORE::shift;
+    return map { $_->getChildNodes } @$self;
+}
+
+sub getElementById {
+    my $self = CORE::shift;
+    return map { $_->getElementById } @$self;
+}
+
+       
 sub to_boolean {
 	my $self = CORE::shift;
 	return (@$self > 0) ? XML::XPathEngine::Boolean->True : XML::XPathEngine::Boolean->False;

Modified: trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/Step.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/Step.pm?rev=18641&op=diff
==============================================================================
--- trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/Step.pm (original)
+++ trunk/libxml-xpathengine-perl/lib/XML/XPathEngine/Step.pm Tue Apr 15 20:03:41 2008
@@ -248,11 +248,11 @@
     my @stack = $context->getChildNodes;
 
     while (@stack) {
-        my $node = pop @stack;
+        my $node = shift @stack;
         if (node_test($self, $node)) {
-            $results->unshift($node);
-        }
-        push @stack, $node->getChildNodes;
+            $results->push($node);
+        }
+        unshift @stack, $node->getChildNodes;
     }
 }
 
@@ -261,14 +261,15 @@
     my ($context, $results) = @_;
     
     my @stack = ($context);
-    
-    while (@stack) {
-        my $node = pop @stack;
-        if (node_test($self, $node)) {
-            $results->unshift($node);
-        }
-        push @stack, $node->getChildNodes;
-    }
+
+     while (@stack) {
+        my $node = shift @stack;
+         if (node_test($self, $node)) {
+            $results->push($node);
+         }
+        #warn "node is a ", ref( $node);
+        unshift @stack, $node->getChildNodes;
+     }
 }
 
 sub axis_following 

Modified: trunk/libxml-xpathengine-perl/t/01_basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpathengine-perl/t/01_basic.t?rev=18641&op=diff
==============================================================================
--- trunk/libxml-xpathengine-perl/t/01_basic.t (original)
+++ trunk/libxml-xpathengine-perl/t/01_basic.t Tue Apr 15 20:03:41 2008
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 23;
+use Test::More tests => 31;
 use XML::XPathEngine;
 
 BEGIN { push @INC, './t'; }
@@ -35,8 +35,8 @@
 
 is( $xp->findvalue( '//kid1[@att1=~/v[345]/]', $tree), 'vkid3vkid5', "match on attributes");
 
-is( $xp->findvalue( '//@*', $tree), 'v1v1vvvx1v2vvvx0v3vvvx1v4vvvx0v5vvvx1', 'match all attributes');
-is( $xp->findvalue( '//@*[parent::*/@att1=~/v[345]/]', $tree), 'v3v4v5', 'match all attributes with a test');
+is( $xp->findvalue( '//@*', $tree), 'i1v1i2v1i3vvi4vx1i5v2i6vvi7vx0i8v3i9vvi10vx1i11v4i12vvi13vx0i14v5i15vvi16vx1i17', 'match all attributes');
+is( $xp->findvalue( '//@*[parent::*/@att1=~/v[345]/]', $tree), 'v3i9v4i12v5i15', 'match all attributes with a test');
 
 is( $xp->findvalue( '//kid1[@att1="v3"]/following::gkid2[1]', $tree), 'gkid2 4', "following axis[1]");
 is( $xp->findvalue( '//kid1[@att1="v3"]/following::gkid2[2]', $tree), 'gkid2 5', "following axis[2]");
@@ -57,18 +57,32 @@
 is( $xp->findvalue( 'count(//gkid2[@att2="vx" and @att3])', $tree), 5, 'count with and');
 is( $xp->findvalue( 'count(//gkid2[@att2="vx" or @att3])', $tree), 5, 'count with or');
 
+#warn $xp->findvalue( './/*/@id', $tree);
+is( $xp->findvalue( '(.//*)[2]/@id', $tree), 'i3', '(descendant::*)[2]');
+
+is( $xp->findvalue( '//kid1[@att1="v3"]/following::gkid2[1]', $tree), 'gkid2 4', "following axis[1]");
+is( $xp->findvalue( '//kid1[@att1="v3"]/following::gkid2[2]', $tree), 'gkid2 5', "following axis[2]");
+
+is( $xp->findvalue( 'id("i2")/@att1', $tree), 'v1', 'id()');
+is( $xp->findvalue( 'substring-after(//kid1[1]/@att1, "v")', $tree), '1', 'substring-after');
+is( $xp->findvalue( 'id("i3")//*[1]/@att2', $tree), 'vv', 'id descendants attribute');
+is( $xp->findvalue( '(id("i3")//*)[1]/@att2', $tree), 'vv', 'grouped id descendants attribute');
+is( $xp->findvalue( 'substring-after((id("i2")//*[1])/@att2, "v")', $tree), 'v', 'substring-after(id())');
 
 sub init_tree
-  { my $tree  = tree->new( 'att', name => 'tree', value => 'tree');
-    my $root  = tree->new( 'att', name => 'root', value => 'root_value', att1 => 'v1');
+  { my $id=0;
+
+    my $tree  = tree->new( 'att', name => 'tree', value => 'tree', id => "i" . ++$id);
+    my $root  = tree->new( 'att', name => 'root', value => 'root_value', att1 => 'v1', id => "i" . ++$id);
     $root->add_as_last_child_of( $tree);
 
+
     foreach (1..5)
-      { my $kid= tree->new( 'att', name => 'kid' . $_ % 2, value => "vkid$_", att1 => "v$_");
+      { my $kid= tree->new( 'att', name => 'kid' . $_ % 2, value => "vkid$_", att1 => "v$_", id => "i" . ++$id);
         $kid->add_as_last_child_of( $root);
-        my $gkid1= tree->new( 'att', name => 'gkid' . $_ % 2, value => "gvkid$_", att2 => "vv");
+        my $gkid1= tree->new( 'att', name => 'gkid' . $_ % 2, value => "gvkid$_", att2 => "vv", id => "i" . ++$id);
         $gkid1->add_as_last_child_of( $kid);
-        my $gkid2= tree->new( 'att', name => 'gkid2', value => "gkid2 $_", att2 => "vx", att3 => $_ % 2);
+        my $gkid2= tree->new( 'att', name => 'gkid2', value => "gkid2 $_", att2 => "vx", att3 => $_ % 2, id => "i" . ++$id);
         $gkid2->add_as_last_child_of( $kid);
       }
 
@@ -76,7 +90,6 @@
 
     return $tree;
   }
-
 
 package tree;
 use base 'minitree';
@@ -92,6 +105,7 @@
 sub getNextSibling     { return shift->next_sibling;        }
 sub getPreviousSibling { return shift->previous_sibling;    }
 sub isElementNode      { return 1;                          }
+sub isAttributeNode    { return 0;                          }
 sub get_pos            { return shift->pos;          }
 sub getAttributes      { return wantarray ? @{shift->attributes} : shift->attributes; }
 sub as_xml 
@@ -104,6 +118,18 @@
 
 sub cmp { my( $a, $b)= @_; return $a->pos <=> $b->pos; }
 
+sub getElementById
+  { my $elt = shift;
+    my $id = shift;
+    foreach ( @{$elt->attributes} ) {
+    	$_->getName eq 'id' and $_->getValue eq $id and return $elt;
+    }
+    foreach ( $elt->getChildNodes ) {
+    	return $_->getElementById($id);
+    }
+}
+
+
 1;
 
 package att;
@@ -115,9 +141,13 @@
 sub getRootNode        { return shift->parent->root;        }
 sub getParentNode      { return shift->parent;              }
 sub isAttributeNode    { return 1;                          }
-sub getChildNodes      { return; }
+sub getChildNodes      { return ; }
 
 sub cmp { my( $a, $b)= @_; return $a->pos <=> $b->pos; }
 
+sub getElementById
+  { return shift->getParentNode->getElementById( @_); }
+
+
 1;
 




More information about the Pkg-perl-cvs-commits mailing list