From fc370b31446533cc74a03f2af3949370a07e9980 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Mon, 6 May 2013 14:22:16 +0200
Subject: [PATCH] Accept more-digit number in _traverse()
When sending a large object (many levels deep) through SOAP::Lite,
you got an error: Incorrect parameter at
/usr/lib/perl5/site_perl/5.8.8/SOAP/Lite.pm line 1993.
This fixes wrong check for a number.
Thanks to aharper[...]ecstuning.com and TONVOON[...]cpan.org.
<
https://rt.cpan.org/Public/Bug/Display.html?id=78692>
---
lib/SOAP/Lite.pm | 2 +-
t/02-payload.t | 11 ++++++++++-
2 files changed, 11 insertions(+), 2 deletions(-)
diff --git a/lib/SOAP/Lite.pm b/lib/SOAP/Lite.pm
index 691e675..a37b27a 100644
--- a/lib/SOAP/Lite.pm
+++ b/lib/SOAP/Lite.pm
@@ -1990,7 +1990,7 @@ sub match {
sub _traverse {
my ($self, $pointer, $itself, $path, @path) = @_;
- die "Incorrect parameter" unless $itself =~/^\d$/;
+ die "Incorrect parameter" unless $itself =~/^\d+$/;
if ($path && substr($path, 0, 1) eq '{') {
$path = join '/', $path, shift @path while @path && $path !~ /}/;
diff --git a/t/02-payload.t b/t/02-payload.t
index 6501ac1..1ab5171 100644
--- a/t/02-payload.t
+++ b/t/02-payload.t
@@ -10,7 +10,7 @@ BEGIN {
use strict;
use Test;
-BEGIN { plan tests => 131 }
+BEGIN { plan tests => 133 }
use SOAP::Lite;
$SIG{__WARN__} = sub { ; }; # turn off deprecation warnings
@@ -97,6 +97,12 @@ my($a, $s, $r, $serialized, $deserialized);
<item2 xsi:type="xsd:int">60</item2>
<item2 xsi:type="xsd:int">100</item2>
<item3 xsi:type="xsd:int">200</item3>
+<item3 xsi:type="xsd:int">200</item3>
+<item4 xsi:type="xsd:int">200</item4>
+<item4 xsi:type="xsd:int">200</item4>
+<item5 xsi:type="xsd:int">400</item5>
+<item5 xsi:type="xsd:int">450</item5>
+<item6 xsi:type="xsd:int">600</item6>
</nums>
</m:doublerResponse>
</soap:Body>
@@ -108,6 +114,9 @@ my($a, $s, $r, $serialized, $deserialized);
ok($deserialized->valueof("$result/[1]") == 20);
ok($deserialized->valueof("$result/[3]") == 60);
ok($deserialized->valueof("$result/[5]") == 200);
+ ok($deserialized->valueof("$result/[9]") == 400);
+ # Test more than 9 items to check depth is okay - RT78692
+ ok($deserialized->valueof("$result/[11]") == 600);
# match should return true/false in boolean context (and object ref otherwise)
ok($deserialized->match('aaa') ? 0 : 1);
--
1.8.1.4
