XML::XPathEngineパッチ - ロックスターになりたい

パッチ作った。

descendantとdescendant-or-selfで出てくる順番がおかしかったのを修正
(id("1")//*)[1]/@att2 みたいにグルーピングしてるのの中にidがあって外側が@attrなときに実行時例外(Can't locate object method "getElementById" via package "XML::XPathEngine::NodeSet")が出るのの修正

amachangのテストコードはpiを除いて通るようになったけどamachangのテストコードはかっこをつかってるやつが少なくてそのへんでまだ問題が残ってる雰囲気が濃厚だった。 (id("1")//*)[1]/@att2 はいけるんだけど (.//*)[1]/@att2 にすると例外が出た気がする(axis axis_descendant not implemented [Can't locate object method "getChildNodes" via package "XML::XPathEngine::NodeSet")
つくづくテストコードちょう重要だとおもった。

~~レポートしようとしたらなんかCPANおかしくてできなかったのでここにはっとく。~~
Fx3がSSLのcertがオレオレだと繋がらなかったときと同じような画面出してて、それに気がつかなくて繋がらなかったんだと思ってただけでした....

--- XML-XPathEngine-0.09/lib/XML/XPathEngine/Function.pm        2007-01-22 04:29:05.000000000 +0900
+++ XML-XPathEngine-0.09-me/lib/XML/XPathEngine/Function.pm     2008-04-14 23:23:41.000000000 +0900
@@ -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,9 @@
         my $string = $self->string($node, $params[0]);
         $_ = $string->value; # get perl scalar
         my @ids = split; # splits $_
+        if ( $node->isa('HTML::TreeBuilder::XPath::Attribute') ) {
+            $node = ($node->getParentNode->getRootNode->getChildNodes)->[0];
+        }
         foreach my $id (@ids) {
             if (my $found = $node->getElementById($id)) {
                 $results->push($found);
diff -EbBw --strip-trailing-cr --exclude=CVS --exclude='*.o' --exclude=.svn -ruw XML-XPathEngine-0.09/lib/XML/XPathEngine/Step.pm XML-XPathEngine-0.09-me/lib/XML/XPathEngine/Step.pm
--- XML-XPathEngine-0.09/lib/XML/XPathEngine/Step.pm    2008-01-18 21:41:31.000000000 +0900
+++ XML-XPathEngine-0.09-me/lib/XML/XPathEngine/Step.pm 2008-04-14 22:11:58.000000000 +0900
@@ -245,11 +245,11 @@
     my @stack = $context->getChildNodes;

     while (@stack) {
-        my $node = pop @stack;
+        my $node = shift @stack;
         if (node_test($self, $node)) {
-            $results->unshift($node);
+            $results->push($node);
         }
-        push @stack, $node->getChildNodes;
+        unshift @stack, $node->getChildNodes;
     }
 }

@@ -260,11 +260,11 @@
     my @stack = ($context);

     while (@stack) {
-        my $node = pop @stack;
+        my $node = shift @stack;
         if (node_test($self, $node)) {
-            $results->unshift($node);
+            $results->push($node);
         }
-        push @stack, $node->getChildNodes;
+        unshift @stack, $node->getChildNodes;
     }
 }

Only in XML-XPathEngine-0.09: pm_to_blib
Only in XML-XPathEngine-0.09-me/t: .01_basic.t.swo
diff -EbBw --strip-trailing-cr --exclude=CVS --exclude='*.o' --exclude=.svn -ruw XML-XPathEngine-0.09/t/01_basic.t XML-XPathEngine-0.09-me/t/01_basic.t
--- XML-XPathEngine-0.09/t/01_basic.t   2008-04-11 16:47:19.000000000 +0900
+++ XML-XPathEngine-0.09-me/t/01_basic.t        2008-04-14 23:21:20.000000000 +0900
@@ -3,7 +3,7 @@
 use strict;
 use warnings;

-use Test::More tests => 15;
+use Test::More tests => 21;
 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), 'v1v1vvvxv2vvvxv3vvvxv4vvvxv5vvvx', 'match all attributes');
-is( $xp->findvalue( '//@*[parent::*/@att1=~/v[345]/]', $tree), 'v3v4v5', 'match all attributes with a test');
+is( $xp->findvalue( '//@*', $tree), 'v1v11vvvxv22vvvxv33vvvxv44vvvxv55vvvx', 'match all attributes');
+is( $xp->findvalue( '//@*[parent::*/@att1=~/v[345]/]', $tree), 'v33v44v55', '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]");
@@ -45,14 +45,21 @@
 is( $xp->findvalue( '//kid1[@att1="v3"]/preceding::gkid2[2]', $tree), 'gkid2 1', "preceding axis[1]");
 is( $xp->findvalue( '//kid1[@att1="v3"]/preceding::gkid2', $tree), 'gkid2 1gkid2 2', "preceding axis");
 is( $xp->findvalue( 'count(//kid1)', $tree), '3', 'preceding count');
+is( $xp->findvalue( '(.//*)[2]', $tree), 'vkid1', '(descendant::*)[2]');
+is( $xp->findvalue( 'id("1")/@att1', $tree), 'v1', 'id()');
+is( $xp->findvalue( 'substring-after(//kid1[1]/@att1, "v")', $tree), '1', 'substring-after');
+is( $xp->findvalue( 'id("1")//*[1]/@att2', $tree), 'vv', 'id descendants attribute');
+is( $xp->findvalue( '(id("1")//*)[1]/@att2', $tree), 'vv', 'grouped id descendants attribute');
+is( $xp->findvalue( 'substring-after((id("1")//*[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');
     $root->add_as_last_child_of( $tree);

+       my $id = 0;
     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 => ++$id);
         $kid->add_as_last_child_of( $root);
         my $gkid1= tree->new( 'att', name => 'gkid' . $_ % 2, value => "gvkid$_", att2 => "vv");
         $gkid1->add_as_last_child_of( $kid);
@@ -82,6 +89,17 @@
 sub isElementNode      { return 1;                          }
 sub get_pos            { return shift->pos;          }
 sub getAttributes      { return wantarray ? @{shift->attributes} : shift->attributes; }
+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);
+    }
+}
 sub as_xml
   { my $elt= shift;
     return "<" . $elt->getName . join( "", map { " " . $_->getName . '="' . $_->getValue . '"' } $elt->getAttributes) . '>'