From ee3c0027e15d11b0bdec1d9d0341f486a1a32d7b Mon Sep 17 00:00:00 2001
From: Yuriy Nevinitsin <nevinitsin@corp.mail.ru>
Date: Tue, 3 Jul 2012 12:28:10 +0400
Subject: [PATCH] [connector][perl] fix long tuple handlers
---
connector/perl/lib/MR/Tarantool/Box.pm | 8 +++++---
connector/perl/t/box.pl | 10 +++++++---
2 files changed, 12 insertions(+), 6 deletions(-)
diff --git a/connector/perl/lib/MR/Tarantool/Box.pm b/connector/perl/lib/MR/Tarantool/Box.pm
index 265355623c..da992dc6e7 100644
--- a/connector/perl/lib/MR/Tarantool/Box.pm
+++ b/connector/perl/lib/MR/Tarantool/Box.pm
@@ -296,7 +296,8 @@ sub _make_unpack_format {
$ns->{byfield_unpack_format} = [ map { m/[\&\$]/ ? 'w/a*' : "x$_" } @f ];
$ns->{field_format} = [ map { m/[\&\$]/ ? 'a*' : $_ } @f ];
$ns->{unpack_format} = join('', @{$ns->{byfield_unpack_format}});
- $ns->{unpack_format} .= '('.join('', @{$ns->{long_byfield_unpack_format}}).')*' if $ns->{long_tuple};
+ $ns->{long_unpack_format} = $ns->{long_tuple} ? join('', @{$ns->{long_byfield_unpack_format}}) : '';
+ $ns->{full_unpack_format} = $ns->{long_tuple} ? $ns->{unpack_format}.'('.$ns->{long_unpack_format}.')*' : $ns->{unpack_format};
$ns->{string_keys} = { map { $_ => 1 } grep { $f[$_] =~ m/[\&\$]/ } 0..$#f };
$ns->{utf8_fields} = { map { $_ => $_ } grep { $f[$_] eq '$' } 0..$#f };
}
@@ -788,6 +789,7 @@ sub _unpack_select {
my (@res);
my $appe = $ns->{append_for_unpack};
my $fmt = $ns->{unpack_format};
+ my $ffmt = $ns->{full_unpack_format};
for(my $i = 0; $i < $result_count; ++$i) {
confess __LINE__."$self->{name}: [$debug_prefix]: Bad response" if length $_[3] < 8;
my ($len, $cardinality) = unpack('LL', substr($_[3], 0, 8, ''));
@@ -796,7 +798,7 @@ sub _unpack_select {
my $packed_tuple = substr($_[3], 0, $len, '');
$self->_debug("$self->{name}: [$debug_prefix]: ROW[$i]: DATA=[@{[unpack '(H2)*', $packed_tuple]}];") if $self->{debug} >= 6;
$packed_tuple .= $appe;
- my @tuple = eval { unpack($fmt, $packed_tuple) };
+ my @tuple = eval { unpack($cardinality > @{$ns->{byfield_unpack_format}} ? $ffmt : $fmt, $packed_tuple) };
confess "$self->{name}: [$debug_prefix]: ROW[$i]: can't unpack tuple [@{[unpack('(H2)*', $packed_tuple)]}]: $@" if !@tuple || $@;
$self->_debug("$self->{name}: [$debug_prefix]: ROW[$i]: FIELDS=[@{[map { qq{`$_'} } @tuple]}];") if $self->{debug} >= 5;
push @res, \@tuple;
@@ -910,7 +912,7 @@ sub _PostSelect {
for my $row (@$r) {
my $h = { zip @{$namespace->{fields}}, @{[splice(@$row,0,0+@f)]} };
if($last) {
- $row = [ map +{ zip @f_long, @{[splice(@$row,0,0+@f_long)]} }, 0..((@$row-1)/@f_long) ] if @f_long;
+ $row = @f_long && @$row ? [ map +{ zip @f_long, @{[splice(@$row,0,0+@f_long)]} }, 0..((@$row-1)/@f_long) ] : [];
$h->{$last} = $row;
}
$row = $h;
diff --git a/connector/perl/t/box.pl b/connector/perl/t/box.pl
index 3be1120d8d..3c8333283e 100644
--- a/connector/perl/t/box.pl
+++ b/connector/perl/t/box.pl
@@ -13,7 +13,7 @@ use FindBin qw($Bin);
use lib "$Bin";
use Carp qw/confess/;
-use Test::More tests => 366;
+use Test::More tests => 371;
use Test::Exception;
use List::MoreUtils qw/zip/;
@@ -37,6 +37,7 @@ our $server = (shift || $ENV{BOX}) or die;
our %opts = (
debug => $ENV{DEBUG}||0,
ipdebug => $ENV{IPDEBUG}||0,
+ retry_delay => 0.1,
raise => 1,
);
@@ -936,6 +937,7 @@ do {
[3, "asdasdasd3", "qqq\xD0\x8Eqqq3", "ww\xD0\x8Eww3", "la\xD0\x8Elalala31", "la\xD0\x8Elala31", "lala31", "lalalala32", "lalala32", "lala32"],
[4, "asdasdasd4", "qqq\xD0\x8Eqqq4", "ww\xD0\x8Eww4", "la\xD0\x8Elalala41", "la\xD0\x8Elala41", "lala41", "lalalala42", "lalala42", "lala42", "lalalala43", "lalala43", "lala43"],
[5, "asdasdasd5", "qqq\xD0\x8Eqqq5", "ww\xD0\x8Eww5", "la\xD0\x8Elalala51", "la\xD0\x8Elala51", "lala51"],
+ [6, "asdasdasd6", "qqq\xD0\x8Eqqq6", "ww\xD0\x8Eww6"],
];
my $check = [];
@@ -966,8 +968,10 @@ do {
is_deeply [$res=$box->Select([map {$_->[0]} @$tuples],{want=>'arrayref'})], [$check], 'select all';
# print $res->[0]->{f3}, "\n";
# print $check->[0]->{f3}, "\n";
- ok $res->[$_]->{f3} eq $check->[$_]->{f3}, "utf8chk" for 0..$#$tuples;
- ok $res->[$_]->{LL}->[0]->{l2} eq $check->[$_]->{LL}->[0]->{l2}, "utf8chklong" for 0..$#$tuples;
+
+ ok $res->[$_]->{f3} eq $check->[$_]->{f3}, "utf8chk" for 0..$#$tuples;
+
+ @{$check->[$_]->{LL}} and ok $res->[$_]->{LL}->[0]->{l2} eq $check->[$_]->{LL}->[0]->{l2}, "utf8chklong" for 0..$#$tuples;
is_deeply [$box->UpdateMulti($tuples->[2]->[0],[ $flds->[3] => set => $tuples->[2]->[3] ],{want_updated_tuple => 1})], [$check->[2]], 'update1';
ok $box->UpdateMulti($tuples->[2]->[0],[ $flds->[3] => set => $tuples->[2]->[3] ]), 'update2';
--
GitLab