diff --git a/connector/perl/lib/MR/Tarantool/Box.pm b/connector/perl/lib/MR/Tarantool/Box.pm index 265355623cae80bfef2da6fed5b0a6ec24bd4df8..da992dc6e7a0a15591dbe4add4c98f070a3bb2af 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 3be1120d8d52f62b216f4db7c7760e9b07b370b5..3c8333283e87fa2a7226b09ccde7c019b54667bc 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';