diff --git a/connector/perl/lib/MR/Tarantool/Box.pm b/connector/perl/lib/MR/Tarantool/Box.pm
index c0701dcfff6b02a8fe01f2bb073733cd0111f4be..a89938779b85563d6b982bc137db00601c947d01 100644
--- a/connector/perl/lib/MR/Tarantool/Box.pm
+++ b/connector/perl/lib/MR/Tarantool/Box.pm
@@ -19,9 +19,10 @@ MR::Tarantool::Box - A driver for an efficient Tarantool/Box NoSQL in-memory sto
index_name => 'idx2',
keys => [1,2],
}, ],
- space => 1, # space id, as set in Tarantool/Box config
- name => "primary", # self-descriptive space-id
- format => "QqLlSsCc&", # pack()-compatible, Qq must be supported by perl itself, & stands for byte-string.
+ space => 1, # space id, as set in Tarantool/Box config
+ name => "primary", # self-descriptive space-id
+ format => "QqLlSsCc&$", # pack()-compatible, Qq must be supported by perl itself,
+ # & stands for byte-string, $ stands for utf8 string.
default_index => 'idx1',
fields => [qw/ id f2 field3 f4 f5 f6 f7 f8 misc_string /], # turn each tuple into hash, field names according to format
}, {
@@ -66,6 +67,7 @@ use warnings;
use Scalar::Util qw/looks_like_number/;
use List::MoreUtils qw/each_arrayref zip/;
use Time::HiRes qw/sleep/;
+use Encode;
use MR::IProto ();
@@ -79,7 +81,7 @@ use constant {
sub IPROTOCLASS () { 'MR::IProto' }
use vars qw/$VERSION %ERRORS/;
-$VERSION = 0.0.21;
+$VERSION = 0.0.22;
BEGIN { *confess = \&MR::IProto::confess }
@@ -152,9 +154,10 @@ Self-descriptive space id, which will be mapped into C<space>.
=item B<format> => $format_string
-C<pack()>-compatible tuple format string, allowed formats: C<QqLlSsCc&>,
-where C<&> stands for bytestring. C<Qq> usable only if perl supports
+C<pack()>-compatible tuple format string, allowed formats: C<QqLlSsC(c&$)*>,
+where C<&> stands for bytestring, C<$> stands for L</utf8> string. C<Qq> usable only if perl supports
int64 itself. Tuples' fields are packed/unpacked according to this C<format>.
+C<< * >> at the end of C<format> enables L</LongTuple>.
=item B<hashify> => B<$coderef>
@@ -170,6 +173,15 @@ It receives C<space> id and resultset as arguments. No return value needed.
Specify an arrayref of fields names according to C<format> to turn each
tuple into a good-looking hash. Names must begin with C<< [A-Za-z] >>.
+If L</LongTuple> enabled, last field will be used to fold tailing fields.
+
+=item B<long_fields> => B<$arrayref>
+
+Specify an arrayref of fields names according to C<< (xxx)* >> to turn
+tailing fields into a good-looking array of hashes.
+Names must begin with C<< [A-Za-z] >>.
+Works with L</LongTuple> enabled only.
+
=item B<indexes> => [ \%index, ... ]
@@ -264,6 +276,31 @@ A string used for self-description. Mainly used for debugging purposes.
=cut
+sub _make_unpack_format {
+ my ($ns,$prefix) = @_;
+ $ns->{format} =~ s/\s+//g;
+ confess "${prefix} bad format `$ns->{format}'" unless $ns->{format} =~ m/^[\$\&lLsScCqQ]*(?:\([\$\&lLsScCqQ]+\)\*|\*)?$/;
+ $ns->{long_tuple} = 1 if $ns->{format} =~ s/\*$//;
+ $ns->{long_format} = '';
+ my @f_long;
+ if ($ns->{long_tuple}) {
+ $ns->{format} =~ s/( \( [^\)]* \) | . )$//x;
+ $ns->{long_format} = $1;
+ $ns->{long_format} =~ s/[()]*//g;
+ @f_long = split //, $ns->{long_format};
+ $ns->{long_byfield_unpack_format} = [ map { m/[\&\$]/ ? 'w/a*' : "x$_" } @f_long ];
+ $ns->{long_field_format} = [ map { m/[\&\$]/ ? 'a*' : $_ } @f_long ];
+ $ns->{long_utf8_fields} = [ grep { $f_long[$_] eq '$' } 0..$#f_long ];
+ }
+ my @f = split //, $ns->{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->{string_keys} = { map { $_ => 1 } grep { $f[$_] =~ m/[\&\$]/ } 0..$#f };
+ $ns->{utf8_fields} = { map { $_ => $_ } grep { $f[$_] eq '$' } 0..$#f };
+}
+
sub new {
my ($class, $arg) = @_;
my $self;
@@ -300,15 +337,12 @@ sub new {
confess "space[$namespace] no indexes defined" unless $ns->{indexes} && @{$ns->{indexes}};
$namespaces{$namespace} = $ns;
$namespaces{$ns->{name}} = $ns if $ns->{name};
- confess "space[$namespace] bad format `$ns->{format}'" if $ns->{format} =~ m/[^&lLsScCqQ ]/;
- $ns->{format} =~ s/\s+//g;
- my @f = split //, $ns->{format};
- $ns->{byfield_unpack_format} = [ map { /&/ ? 'w/a*' : "x$_" } @f ];
- $ns->{field_format} = [ map { /&/ ? 'a*' : $_ } @f ];
- $ns->{unpack_format} = join('', @{$ns->{byfield_unpack_format}});
+
+ _make_unpack_format($ns,"space[$namespace]");
+
$ns->{append_for_unpack} = '' unless defined $ns->{append_for_unpack};
$ns->{check_keys} = {};
- $ns->{string_keys} = { map { $_ => 1 } grep { $f[$_] eq '&' } 0..$#f };
+
my $inames = $ns->{index_names} = {};
my $i = -1;
for my $index (@{$ns->{indexes}}) {
@@ -319,7 +353,7 @@ sub new {
confess "space[$namespace]index[$index_name($i)] already defined" if $inames->{$index_name} || $inames->{$i};
$index->{id} = $i unless defined $index->{id};
$inames->{$i} = $inames->{$index_name} = $index;
- int $_ == $_ and $_ >= 0 and $_ < @f or confess "space[$namespace]index[$index_name] bad key `$_'" for @{$ns->{keys}};
+ int $_ == $_ and $_ >= 0 and $_ < @{$ns->{field_format}} or confess "space[$namespace]index[$index_name] bad key `$_'" for @{$ns->{keys}};
$ns->{check_keys}->{$_} = int !! $ns->{string_keys}->{$_} for @{$index->{keys}};
$index->{string_keys} ||= $ns->{string_keys};
}
@@ -332,13 +366,19 @@ sub new {
$ns->{default_index} ||= 0;
$ns->{primary_key_index} ||= 0;
}
- $ns->{fields} ||= $arg->{default_fields};
+ $ns->{fields} ||= $arg->{default_fields};
+ $ns->{long_fields} ||= $arg->{default_long_fields};
if($ns->{fields}) {
confess "space[$namespace] fields must be ARRAYREF" unless ref $ns->{fields} eq 'ARRAY';
- confess "space[$namespace] fields number must match format" if @{$ns->{fields}} != @f;
+ confess "space[$namespace] fields number must match format" if @{$ns->{fields}} != int(!!$ns->{long_tuple})+@{$ns->{field_format}};
m/^[A-Za-z]/ or confess "space[$namespace] fields names must begin with [A-Za-z]: bad name $_" for @{$ns->{fields}};
$ns->{fields_hash} = { map { $ns->{fields}->[$_] => $_ } 0..$#{$ns->{fields}} };
}
+ if($ns->{long_fields}) {
+ confess "space[$namespace] long_fields must be ARRAYREF" unless ref $ns->{long_fields} eq 'ARRAY';
+ confess "space[$namespace] long_fields number must match format" if @{$ns->{long_fields}} != @{$ns->{long_field_format}};
+ m/^[A-Za-z]/ or confess "space[$namespace] long_fields names must begin with [A-Za-z]: bad name $_" for @{$ns->{long_fields}};
+ }
$ns->{default_raw} = 1 if !defined$ns->{default_raw} and defined $ns->{hashify} and !$ns->{hashify};
}
$self->{namespaces} = \%namespaces;
@@ -571,12 +611,26 @@ sub Call {
$self->_debug("$self->{name}: CALL($sp_name)[${\join ' ', map {join' ',unpack'(H2)*',$_} @$tuple}]") if $self->{debug} >= 4;
confess "All fields must be defined" if grep { !defined } @$tuple;
- confess "Bad `unpack_format` option" if exists $param->{unpack_format} and ref $param->{unpack_format} ne 'ARRAY';
- my $unpack_format = join '', map { /&/ ? 'w/a*' : "x$_" } @{$param->{unpack_format}};
+ confess "Required `unpack_format` option wasn't defined"
+ unless exists $param->{unpack} or exists $param->{unpack_format} and $param->{unpack_format};
+
+ my $unpack_format = $param->{unpack_format};
+ if($unpack_format) {
+ $unpack_format = join '', @$unpack_format if ref $unpack_format;
+ my $f = { format => $unpack_format };
+ _make_unpack_format($f, "CALL");
+ $unpack_format = $f->{unpack_format};
+ }
local $namespace->{unpack_format} = $unpack_format if $unpack_format; # XXX
local $namespace->{append_for_unpack} = '' if $unpack_format; # shit...
+ $tuple = [ map {
+ my $x = $_;
+ Encode::_utf8_off($x) if Encode::is_utf8($x,0);
+ $x;
+ } @$tuple ];
+
$self->_chat (
msg => 22,
payload => pack("L w/a* L(w/a*)*", $flags, $sp_name, scalar(@$tuple), @$tuple),
@@ -662,7 +716,6 @@ sub Insert {
$param->{want_result} = $param->{want_inserted_tuple} if !defined $param->{want_result};
-
my $flags = $param->{_flags} || 0;
$flags |= WANT_RESULT if $param->{want_result};
@@ -676,10 +729,13 @@ sub Insert {
}
my $chkkey = $namespace->{check_keys};
my $fmt = $namespace->{field_format};
- confess "Wrong fields number in tuple" if @tuple != @$fmt;
+ my $long_fmt = $namespace->{long_field_format};
+ my $chk_divisor = $namespace->{long_tuple} ? @$long_fmt : @$fmt;
+ confess "Wrong fields number in tuple" if 0 != (@tuple - @$fmt) % $chk_divisor;
for (0..$#tuple) {
confess "$self->{name}: ref in tuple $_=`$tuple[$_]'" if ref $tuple[$_];
no warnings 'uninitialized';
+ Encode::_utf8_off($_) if Encode::is_utf8($_,0);
if(exists $chkkey->{$_}) {
if($chkkey->{$_}) {
confess "$self->{name}: undefined key $_" unless defined $tuple[$_];
@@ -687,7 +743,7 @@ sub Insert {
confess "$self->{name}: not numeric key $_=`$tuple[$_]'" unless looks_like_number($tuple[$_]) && int($tuple[$_]) == $tuple[$_];
}
}
- $tuple[$_] = pack($fmt->[$_], $tuple[$_]);
+ $tuple[$_] = pack($_ < @$fmt ? $fmt->[$_] : $long_fmt->[$_ % @$long_fmt], $tuple[$_]);
}
$self->_debug("$self->{name}: INSERT[${\join ' ', map {join' ',unpack'(H2)*',$_} @tuple}]") if $self->{debug} >= 4;
@@ -771,6 +827,7 @@ sub _pack_keys {
$strkey = $strkey->{$keys->[0]};
foreach (@_[NPRM..$#_]) {
($_) = @$_ if ref $_ eq 'ARRAY';
+ Encode::_utf8_off($_) if Encode::is_utf8($_,0);
unless ($strkey) {
confess "$self->{name}: not numeric key [$_]" unless looks_like_number($_) && int($_) == $_;
$_ = pack($fmt, $_);
@@ -784,6 +841,7 @@ sub _pack_keys {
unless ($strkey->{$keys->[$i]}) {
confess "$self->{name}: not numeric key [$i][$k->[$i]]" unless looks_like_number($k->[$i]) && int($k->[$i]) == $k->[$i];
}
+ Encode::_utf8_off($k->[$i]) if Encode::is_utf8($k->[$i],0);
$k->[$i] = pack($fmt->[$keys->[$i]], $k->[$i]);
}
$k = pack('L(w/a*)*', scalar(@$k), @$k);
@@ -796,7 +854,8 @@ sub _PackSelect {
return '' unless @keys;
$self->_pack_keys($namespace, $param->{index}, @keys);
my $format = "";
- if ($param->{format}) {
+ if ($param->{format}) { #broken
+ confess "broken" if $namespace->{long_tuple};
my $f = $namespace->{byfield_unpack_format};
$param->{unpack_format} = join '', map { $f->[$_->{field}] } @{$param->{format}};
$format = pack 'l*', scalar @{$param->{format}}, map {
@@ -815,11 +874,39 @@ sub _PackSelect {
sub _PostSelect {
my ($self, $r, $param, $namespace) = @_;
if(!$param->{raw}) {
+ my @utf8_fields = values %{$namespace->{utf8_fields}};
+ my $long_utf8_fields = $namespace->{long_utf8_fields};
+ if(@utf8_fields or $long_utf8_fields && @$long_utf8_fields) {
+ my $long_tuple = $namespace->{long_tuple};
+ for my $row (@$r) {
+ Encode::_utf8_on($row->[$_]) for @utf8_fields;
+ if ($long_tuple && @$long_utf8_fields) {
+ my $i = @{$namespace->{field_format}};
+ my $n = int( (@$row-$i-1) / @$long_utf8_fields );
+ Encode::_utf8_on($row->[$_]) for map do{ $a=$_; map $a+$i+@$long_utf8_fields*$_, 0..$n }, @$long_utf8_fields;
+ }
+ }
+ }
+
my $hashify = $param->{hashify} || $namespace->{hashify} || $self->{hashify};
- if($hashify) {
+ if ($hashify) {
$hashify->($namespace->{namespace}, $r);
} elsif( $namespace->{fields} ) {
- $_ = { zip @{$namespace->{fields}}, @$_ } for @$r;
+ my @f = @{$namespace->{fields}};
+ my @f_long;
+ my $last;
+ if ($namespace->{long_tuple}) {
+ $last = pop @f;
+ @f_long = @{$namespace->{long_fields}} if $namespace->{long_fields};
+ }
+ 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;
+ $h->{$last} = $row;
+ }
+ $row = $h;
+ }
}
}
}
@@ -900,7 +987,7 @@ Max tuples to select. It is set to C<< MAX_INT32 >> by default.
=item B<raw> => $bool
-Don't C<hashify> (see L</new>).
+Don't C<hashify> (see L</new>), disable L</utf8> processing.
=item B<hash_by> => $by
@@ -1409,6 +1496,52 @@ Usage example:
=back
+=head2 LongTuple
+
+If C<format> given to L</new>, or C<unpack_format> given to L</Call> ends with a star (C<< * >>)
+I<long tuple> is enabled. Last field or group of fields of C<format> represent variable-length
+tail of the tuple. C<long_fields> option given to L</new> will fold the tail into array of hashes.
+
+ $box->Insert(1,"2",3);
+ $box->Insert(3,"2",3,4,5);
+ $box->Insert(5,"2",3,4,5,6,7);
+
+If we set up
+
+ format => "L&CL*",
+ fields => [qw/ a b c d /], # d is the folding field here
+ # no long_fields - no folding into hash
+
+we'll get:
+
+ $result = $box->Select([1,2,3,4,5]);
+ $result = [
+ { a => 1, b => "2", c => 3, d => [] },
+ { a => 3, b => "2", c => 3, d => [4,5] },
+ { a => 5, b => "2", c => 3, d => [4,5,6,7] },
+ ];
+
+And if we set up
+
+ format => "L&C(LL)*",
+ fields => [qw/ a b c d /], # d is the folding field here
+ long_fields => [qw/ d1 d2 /],
+
+we'll get:
+
+ $result = [
+ { a => 1, b => "2", c => 3, d => [] },
+ { a => 3, b => "2", c => 3, d => [{d1=>4, d2=>5}] },
+ { a => 5, b => "2", c => 3, d => [{d1=>4, d2=>5}, {d1=>6, d2=>7}] },
+ ];
+
+
+=head2 utf8
+
+Utf8 strings are supported very simply. When pushing any data to tarantool (with any query, read or write),
+the utf8 flag is set off, so all data is pushed as bytestring. When reading response, for fields marked
+a dollar sign C<< $ >> (see L</new>) (including such in L</LongTuple> tail) utf8 flag is set on.
+That's all. Validity is on your own.
=head1 LICENCE AND COPYRIGHT
diff --git a/connector/perl/lib/MR/Tarantool/Box/Singleton.pm b/connector/perl/lib/MR/Tarantool/Box/Singleton.pm
index 9d4f72d42962b963cb0961deae135c1e7d4d45ba..a99417acb998a69f15fbf30e86a662fd6c3c3107 100644
--- a/connector/perl/lib/MR/Tarantool/Box/Singleton.pm
+++ b/connector/perl/lib/MR/Tarantool/Box/Singleton.pm
@@ -95,17 +95,20 @@ if I<< fields >> were not set explicitly for that space.
=cut
-sub mkfields {
- my($class, @fields) = @_;
+sub _mkfields {
+ my($class, $f, $F, @fields) = @_;
no strict 'refs';
- confess "Fields are already defined for $class" if @{"${class}::fields"};
- @{"${class}::fields"} = @fields;
- %{"${class}::fields"} = map { $fields[$_] => $_ } 0..$#fields;
- eval qq{ sub ${class}::TUPLE_$fields[$_] () { $_ } } for 0..$#fields;
- eval qq{ sub ${class}::FIELDS () { \@${class}::fields } };
- eval qq{ sub ${class}::FIELDS_HASH () { \\\%${class}::fields } };
+ confess "$f are already defined for $class" if @{"${class}::${f}"};
+ @{"${class}::${f}"} = @fields;
+ %{"${class}::${f}"} = map { $fields[$_] => $_ } 0..$#fields;
+ eval qq{ sub ${class}::${F}TUPLE_$fields[$_] () { $_ } } for 0..$#fields;
+ eval qq{ sub ${class}::${F}FIELDS () { \@${class}::${f} } };
+ eval qq{ sub ${class}::${F}FIELDS_HASH () { \\\%${class}::${f} } };
}
+sub mkfields { $_[0]->_mkfields('fields', '', @_[1..$#_]) }
+sub mklongfields { $_[0]->_mkfields('long_fields', 'LONG_', @_[1..$#_]) }
+
=pod
=head3 declare_stored_procedure
@@ -118,7 +121,7 @@ sub mkfields {
options => { default => options }, # MR::Tarantool::Box->Call \%options
params => [ qw{ P1 P2 P3 Param4 }], # names
- unpack_format => [qw/ & L S C /],
+ unpack_format => "&LSC(L$)*",
params_format => [qw{ C S L a* }],
params_default => [ 1, 2, undef, 'the_default' ], # undef's are mandatory params
@@ -174,7 +177,7 @@ its parameter mandatory.
C<< pack() >>-compatible format to pack input parameters. Must match C<params>.
-=item B<unpack_format> => \@format
+=item B<unpack_format> => $format
C<< pack() >>-compatible format to unpack procedure output.
@@ -236,17 +239,22 @@ sub declare_stored_procedure {
confess "`unpack` method $fn is not provided by class ${class}" unless $class->can($fn);
$unpack = sub { $class->$fn(@_) };
}
- $options->{unpack_format} = [ "a*" ];
+ if ($opts{unpack_raw}) {
+ $options->{unpack} = $unpack;
+ undef $unpack;
+ }
+ $options->{unpack_format} = '&*';
} else {
- confess "no `unpack` nor `unpack_format` given; it must be an arrayref" if !exists $opts{unpack_format} or ref $opts{unpack_format} ne 'ARRAY';
+ confess "no `unpack` nor `unpack_format` given" if !exists $opts{unpack_format};
my $f = $opts{unpack_format};
+ $f = join '', @$f if ref $f;
$options->{unpack_format} = $f;
}
my $method = $opts{method_name} or confess "`method_name` not given";
confess "bad `method_name` $method" unless $method =~ m/^[a-zA-Z]\w*$/;
my $fn = "${class}::${method}";
- confess "Method $method id already defined in class $class" if defined &{$fn};
+ confess "Method $method is already defined in class $class" if defined &{$fn};
do {
no strict 'refs';
*$fn = sub {
@@ -323,7 +331,8 @@ sub _new_instance {
$config->{param}->{name} ||= $class;
$config->{param}->{spaces} ||= $class->SPACES;
- $config->{param}->{default_fields} ||= [ $class->FIELDS ] if $class->can('FIELDS');
+ $config->{param}->{default_fields} ||= [ $class->FIELDS ] if $class->can('FIELDS');
+ $config->{param}->{default_long_fields}||= [ $class->LONG_FIELDS ] if $class->can('LONG_FIELDS');
$config->{param}->{raise} = $class->RAISE unless defined $config->{param}->{raise};
$config->{param}->{timeout} ||= $class->TIMEOUT;
diff --git a/connector/perl/t/box.pl b/connector/perl/t/box.pl
index bb6941ffc675b5de9758638f0202c1f81654e410..c979186c7408f79e840e9cbe06ae40ff1759473e 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 => 339;
+use Test::More tests => 360;
use Test::Exception;
use List::MoreUtils qw/zip/;
@@ -898,7 +898,9 @@ foreach my $r (@res) {
}
my $flds;
-BEGIN{ $flds = [qw/ f1 f2 f3 f4 /] }
+my $lflds;
+BEGIN{ $flds = [qw/ f1 f2 f3 f4 LL /] }
+BEGIN{ $lflds = [qw/ l1 l2 l3 /] }
{
package TestBox;
use MR::Tarantool::Box::Singleton;
@@ -906,6 +908,7 @@ BEGIN{ $flds = [qw/ f1 f2 f3 f4 /] }
BEGIN {
__PACKAGE__->mkfields(@$flds);
+ __PACKAGE__->mklongfields(@$lflds);
}
sub SERVER { $server }
@@ -917,7 +920,7 @@ BEGIN{ $flds = [qw/ f1 f2 f3 f4 /] }
index_name => 'primary_id',
keys => [TUPLE_f1],
} ],
- format => 'l&&&',
+ format => 'l&$&(&$&)*',
default_index => 'primary_id',
}]}
@@ -926,24 +929,52 @@ BEGIN{ $flds = [qw/ f1 f2 f3 f4 /] }
$box = 'TestBox';
#$box = $CLASS->new(def_param_flds);
#ok $box->isa($CLASS), 'connect';
-
do {
- my $tuples = [ @$tuples[0..2] ];
+ my $tuples = [
+ [1, "asdasdasd1", "qqq\xD0\x8Eqqq1", "ww\xD0\x8Eww1", "la\xD0\x8Elalala11", "la\xD0\x8Elala11", "lala11"],
+ [2, "asdasdasd2", "qqq\xD0\x8Eqqq2", "ww\xD0\x8Eww2", "la\xD0\x8Elalala21", "la\xD0\x8Elala21", "lala21", "lalalala22", "lalala22", "lala22", "lalalala23", "lalala23", "lala23"],
+ [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"],
+ ];
+
+ my $check = [];
+ for my $tuple (@$tuples) {
+ my $i = 0;
+ Encode::_utf8_on($tuple->[2+$i*3]), ++$i while @$tuple > 1+$i*3;
+
+ my $t = { zip @{[@$flds[0..($#$flds-1)]]}, @{[@$tuple[0..($#$flds-1)]]} };
+ my $l = $t->{$flds->[-1]} = [];
+
+ $i = 1;
+ push(@$l, { zip @$lflds, @{[@$tuple[(1+$i*3)..(1+$i*3+2)]]} }), ++$i while @$tuple > 1+$i*3;
+
+ push @$check, $t;
+ }
+
foreach my $tuple (@$tuples) {
cleanup $tuple->[0];
}
- foreach my $tuple (@$tuples) {
- is_deeply [$box->Insert(@$tuple, {want_inserted_tuple => 1})], [{zip @$flds, @$tuple}], "flds/insert \'$tuple->[0]\'";
+ foreach my $i (0..$#$tuples) {
+ is_deeply [$box->Insert(@{$tuples->[$i]}, {want_inserted_tuple => 1})], [$check->[$i]], "flds/insert \'$tuples->[$i]->[0]\'";
}
- is_deeply [$box->Select([[$tuples->[0]->[0]]])], [{zip @$flds, @{$tuples->[0]}}], 'select by primary_num1 index';
- is_deeply [$box->UpdateMulti($tuples->[0]->[0],[ $flds->[3] => set => $tuples->[0]->[3] ],{want_updated_tuple => 1})], [{zip @$flds, @{$tuples->[0]}}], 'update1';
- ok $box->UpdateMulti($tuples->[0]->[0],[ $flds->[3] => set => $tuples->[0]->[3] ]), 'update2';
- is_deeply [$box->UpdateMulti($tuples->[0]->[0],[ 3 => set => $tuples->[0]->[3] ],{want_updated_tuple => 1})], [{zip @$flds, @{$tuples->[0]}}], 'update3';
- ok $box->UpdateMulti($tuples->[0]->[0],[ 3 => set => $tuples->[0]->[3] ]), 'update4';
+ is_deeply [$box->Select([[$tuples->[0]->[0]]])], [$check->[0]], 'select by primary_num1 index';
+
+ my $res;
+ 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;
+
+ 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';
+ is_deeply [$box->UpdateMulti($tuples->[2]->[0],[ 3 => set => $tuples->[2]->[3] ],{want_updated_tuple => 1})], [$check->[2]], 'update3';
+ ok $box->UpdateMulti($tuples->[2]->[0],[ 3 => set => $tuples->[2]->[3] ]), 'update4';
- is_deeply [$box->Delete($tuples->[0]->[0],{want_deleted_tuple => 1})], [{zip @$flds, @{$tuples->[0]}}], 'update3';
+ is_deeply [$box->Delete($tuples->[$_]->[0],{want_deleted_tuple => 1})], [$check->[$_]], "delete$_" for 0..$#$tuples;
};