r18639 - in /branches/upstream/libxml-xpathengine-perl/current: Changes META.yml 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 19:58:15 UTC 2008
Author: dmn
Date: Tue Apr 15 19:58:14 2008
New Revision: 18639
URL: http://svn.debian.org/wsvn/?sc=1&rev=18639
Log:
[svn-upgrade] Integrating new upstream version, libxml-xpathengine-perl (0.11)
Modified:
branches/upstream/libxml-xpathengine-perl/current/Changes
branches/upstream/libxml-xpathengine-perl/current/META.yml
branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine.pm
branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/Function.pm
branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/NodeSet.pm
branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/Step.pm
branches/upstream/libxml-xpathengine-perl/current/t/01_basic.t
Modified: branches/upstream/libxml-xpathengine-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libxml-xpathengine-perl/current/Changes?rev=18639&op=diff
==============================================================================
--- branches/upstream/libxml-xpathengine-perl/current/Changes (original)
+++ branches/upstream/libxml-xpathengine-perl/current/Changes Tue Apr 15 19:58:14 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: branches/upstream/libxml-xpathengine-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libxml-xpathengine-perl/current/META.yml?rev=18639&op=diff
==============================================================================
--- branches/upstream/libxml-xpathengine-perl/current/META.yml (original)
+++ branches/upstream/libxml-xpathengine-perl/current/META.yml Tue Apr 15 19:58:14 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: branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine.pm?rev=18639&op=diff
==============================================================================
--- branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine.pm (original)
+++ branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine.pm Tue Apr 15 19:58:14 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: branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/Function.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/Function.pm?rev=18639&op=diff
==============================================================================
--- branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/Function.pm (original)
+++ branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/Function.pm Tue Apr 15 19:58:14 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: branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/NodeSet.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/NodeSet.pm?rev=18639&op=diff
==============================================================================
--- branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/NodeSet.pm (original)
+++ branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/NodeSet.pm Tue Apr 15 19:58:14 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: branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/Step.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/Step.pm?rev=18639&op=diff
==============================================================================
--- branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/Step.pm (original)
+++ branches/upstream/libxml-xpathengine-perl/current/lib/XML/XPathEngine/Step.pm Tue Apr 15 19:58:14 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: branches/upstream/libxml-xpathengine-perl/current/t/01_basic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libxml-xpathengine-perl/current/t/01_basic.t?rev=18639&op=diff
==============================================================================
--- branches/upstream/libxml-xpathengine-perl/current/t/01_basic.t (original)
+++ branches/upstream/libxml-xpathengine-perl/current/t/01_basic.t Tue Apr 15 19:58:14 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