MR-Tarantool-0.0.24/0000755000175000017500000000000011764357262015227 5ustar nevinitsinnevinitsinMR-Tarantool-0.0.24/lib/0000755000175000017500000000000011667150202015760 5ustar nevinitsinnevinitsinMR-Tarantool-0.0.24/lib/MR/0000755000175000017500000000000011764347352016312 5ustar nevinitsinnevinitsinMR-Tarantool-0.0.24/lib/MR/Tarantool/0000755000175000017500000000000011764357262020256 5ustar nevinitsinnevinitsinMR-Tarantool-0.0.24/lib/MR/Tarantool/Box/0000755000175000017500000000000011763142335020776 5ustar nevinitsinnevinitsinMR-Tarantool-0.0.24/lib/MR/Tarantool/Box/Singleton.pm0000644000175000017500000003546211755131312023302 0ustar nevinitsinnevinitsinpackage MR::Tarantool::Box::Singleton; =pod =head1 NAME MR::Tarantool::Box::Singleton - A singleton wrapper for L. Provides connection-persistence and replica fallback. Please read L<"MR::Tarantool::Box manual"|MR::Tarantool::Box> first. =head1 SYNOPSIS package Some::Tarantool::Box::Singleton; use MR::Tarantool::Box::Singleton; use base 'MR::Tarantool::Box::Singleton'; BEGIN { # generates "TUPLE_$field_name" constants, and methods: FIELDS, FIELDS_HASH __PACKAGE__->mkfields(qw/ id f1 f2 f3 field4 f5 f6 f7 misc_string /); # applicable for DEFAULT_SPACE only } sub SERVER { Some::Config->GetBoxServer() } sub REPLICAS { Some::Config->GetBoxReplicas() } sub DEFAULT_SPACE { 0 } sub SPACES {[{ space => 0, indexes => [ { index_name => 'primary_id', keys => [TUPLE_id], }, { index_name => 'secondary_f1f2', keys => [TUPLE_f1, TUPLE_f2], }, ], format => 'QqLlSsCc&', default_index => 'primary_id', }, { space => 1, indexes => [ { index_name => 'primary_id', keys => [0], }, ], format => '&&&&', fields => [qw/ string1 str2 s3 s4 /], }]} =head1 DESCRIPTION =head2 METHODS =cut use strict; use warnings; use MR::Tarantool::Box; use Class::Singleton; use Carp qw/confess cluck/; use List::Util qw/shuffle/; use base qw/Class::Singleton/; =pod =head3 mkfields BEGIN { $CLASS->mkfields(@names); } =over =item * Generates constants "TUPLE_$fieldname" => $fieldposition in C<$CLASS>. Just Like if you say C<< use constant TUPLE_id => 0, TUPLE_f1 => 1, ...; >> =item * Generates C<$CLASS> variable C<< @fields >> containing field names, and a C<$CLASS> method C returning C<< @fields >>. =item * Generates C<$CLASS> variable C<< %fields >> containing field names mapping to positions, and a C<$CLASS> method C returning C<< \%fields >>. =item * These C<< @fields >> are applied to the C<< DEFAULT_SPACE >>, if I<< fields >> were not set explicitly for that space. =back =cut sub _mkfields { my($class, $f, $F, @fields) = @_; no strict 'refs'; 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 $CLASS->declare_stored_procedure(%args); $CLASS->declare_stored_procedure( name => "box.do.something", # internal procedure name, in da box method_name => "CallMyTestingStoredProcedure", # will generate method named options => { default => options }, # MR::Tarantool::Box->Call \%options params => [ qw{ P1 P2 P3 Param4 }], # names unpack_format => "&LSC(L$)*", params_format => [qw{ C S L a* }], params_default => [ 1, 2, undef, 'the_default' ], # undef's are mandatory params ); ... my $data = $CLASS->CallMyTestingStoredProcedure( P1 => $val1, P2 => $val2, P3 => $val3, Param4 => $val3, { option => $value }, # optional ) or warn $CLASS->ErrorStr; Declare a stored procedure. This generates C<$CLASS> method C<< $args{method_name} >> which calls Tarantool/Box procedure C<< $args{name} >>, using C<< $args{options} >> as default C<< \%options >> for C<< MR::Tarantool::Box->Call >> call. The generated method has the following prototype: $CLASS->CallMyTestingStoredProcedure( %sp_params, \%optional_options ); Parameters description: =over =item B<%args>: =over =item B => $tarantool_box_sp_name The name of procedure in Tarantool/Box to call. =item B => $class_method_name Class method name to generate. =item B => \%options Options to pass to LCall|MR::Taranatool::Box/Call> method. =item B => \@names Procedure input parameters' names =item B => \@defaults Procedure input parameters default values. Undefined or absent value makes its parameter mandatory. =item B => \@format C<< pack() >>-compatible format to pack input parameters. Must match C. =item B => $format C<< pack() >>-compatible format to unpack procedure output. =back =item B<%sp_params>: C<< Name => $value >> pairs. =item B<%optional_options>: Options to pass to LCall|MR::Taranatool::Box/Call> method. This overrides C<< %options >> values key-by-key. =back =cut sub declare_stored_procedure { my($class, %opts) = @_; my $name = delete $opts{name} or confess "No `name` given"; my $options = $opts{options} || {}; confess "no `params` given; it must be an arrayref" if !exists $opts{params} or ref $opts{params} ne 'ARRAY'; my @params = @{$opts{params}}; my $pack; if(my $fn = $opts{pack}) { confess "`params_format` and `params_default` are not applicable while `pack` is in use" if exists $opts{params_format} or exists $opts{params_default}; if(ref $fn) { confess "`pack` can be code ref or a method name, nothing else" unless ref $fn eq 'CODE'; $pack = $fn; } else { confess "`pack` method $fn is not provided by class ${class}" unless $class->can($fn); $pack = sub { $class->$fn(@_) }; } } else { confess "no `pack` nor `params_format` given; it must be an arrayref with number of elements exactly as in `params`" if !exists $opts{params_format} or ref $opts{params_format} ne 'ARRAY' or @{$opts{params_format}} != @params; confess "`params_default` is given but it must be an arrayref with number of elements no more then in `params`" if exists $opts{params_format} and (ref $opts{params_format} ne 'ARRAY' or @{$opts{params_format}} > @params); my @fmt = @{$opts{params_format}}; my @def = @{$opts{params_default}||[]}; $pack = sub { my $p = $_[0]; for my $i (0..$#params) { $p->[$i] = $def[$i] if !defined$p->[$i] and $i < @def; confess "All params must be defined" unless defined $p->[$i]; $p->[$i] = pack $fmt[$i], $p->[$i]; } return $p; }; } my $unpack; if(my $fn = $opts{unpack}) { if(ref $fn) { confess "`unpack` can be code ref or a method name, nothing else" unless ref $fn eq 'CODE'; $unpack = $fn; } else { confess "`unpack` method $fn is not provided by class ${class}" unless $class->can($fn); $unpack = sub { $class->$fn(@_) }; } if ($opts{unpack_raw}) { $options->{unpack} = $unpack; undef $unpack; } $options->{unpack_format} = '&*'; } else { 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 is already defined in class $class" if defined &{$fn}; do { no strict 'refs'; *$fn = sub { my $p0 = @_ && ref $_[-1] eq 'HASH' ? pop : {}; my $param = { %$options, %$p0 }; my ($class, %params) = @_; my $res = $class->Call($name, $pack->([@params{@params}]), $param) or return; return $res unless $unpack; return $unpack->($res); } }; return $method; } sub Param { confess "bad Param call" unless $_[2]; return $_[2] && @{$_[2]} && ref $_[2]->[-1] eq 'HASH' && pop @{$_[2]} || {}; } =pod =head3 Configuration methods =over =item B Must return a string of ip:port of I server. =item B Must return a comma separated string of ip:port pairs of I servers (see L). Server is chosen from the list randomly. =item B Must return name of the class implementing L interface, or it's descendant. =item B, B, B, B, B, B, B, B See corresponding arguments of Lnew|MR::Tarantool::Box/new> method. =back =cut sub DEBUG () { 0 } sub IPDEBUG () { 0 } sub TIMEOUT () { 23 } sub SELECT_TIMEOUT () { 2 } sub RAISE () { 1 } sub RETRY () { 1 } sub SELECT_RETRY () { 3 } sub SOFT_RETRY () { 3 } sub RETRY_DELAY () { 1 } sub SERVER () { die } sub REPLICAS () { [] } sub MR_TARANTOOL_BOX_CLASS () { 'MR::Tarantool::Box' } sub SPACES () { die } sub DEFAULT_SPACE () { undef } sub _new_instance { my ($class) = @_; my ($config) = $class->can('_config') ? $class->_config : {}; $config->{param} ||= {}; $config->{servers} ||= $class->SERVER; $config->{param}->{name} ||= $class; $config->{param}->{spaces} ||= $class->SPACES; $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; $config->{param}->{select_timeout} ||= $class->SELECT_TIMEOUT; $config->{param}->{debug} ||= $class->DEBUG; $config->{param}->{ipdebug} ||= $class->IPDEBUG; $config->{param}->{retry} ||= $class->RETRY; $config->{param}->{select_retry} ||= $class->SELECT_RETRY; $config->{param}->{softretry} ||= $class->SOFT_RETRY; $config->{param}->{retry_delay} ||= $class->RETRY_DELAY; my $replicas = delete $config->{replicas} || $class->REPLICAS || []; $replicas = [ split /,/, $replicas ] unless ref $replicas eq 'ARRAY'; $class->CheckConfig($config); return bless { box => $class->MR_TARANTOOL_BOX_CLASS->new({ servers => $config->{servers}, %{$config->{param}} }), replicas => [ map { $class->MR_TARANTOOL_BOX_CLASS->new({ servers => $_, %{$config->{param}} }) } shuffle @$replicas ], }, $class; } sub CheckConfig {} =pod =head3 Add, Insert, Replace, UpdateMulti, Delete These methods operate on C<< SERVER >> only. See corresponding methods of L class. =head3 Select, Call These methods operate on C<< SERVER >> at first, and then B try to query C<< REPLICAS >>. See corresponding methods of L class. These methods have additional C<< %options >> params: =over =item B => \$is_result_from_replica If this option is set, then if the query to C<< SERVER >> fails, C<< REPLICAS >> will be queried one-by-one until query succeeds or the list ends, and C<< $is_result_from_replica >> will be set to C<< true >>, no matter whether any query succeeds or not. =back =cut BEGIN { foreach my $method (qw/Insert UpdateMulti Delete Add Set Replace Bit Num AndXorAdd Update/) { no strict 'refs'; *$method = sub { use strict; my ($class, @args) = @_; my $param = $class->Param($method, \@args); my $self = $class->instance; $self->{_last_box} = $self->{box}; $self->{box}->$method(@args, $param); }; } foreach my $method (qw/Select SelectUnion Call/) { no strict 'refs'; *$method = sub { use strict; my ($class, @args) = @_; my $param = $class->Param($method, \@args); if ($param->{format}) { my @F; my $F = $class->FIELDS_HASH; my @format = ref $param->{format} eq 'ARRAY' ? @{$param->{format}} : %{$param->{format}}; confess "Odd number of elements in format" if @format % 2; $param->{format} = []; while( my ($field, $fmt) = splice(@format, 0, 2) ) { confess "Bad format for field `$field'" unless $fmt; confess "Unknown field `$field'" unless exists $F->{$field}; push @F, $field; push @{$param->{format}}, { field => $F->{$field}, $fmt eq 'full' ? ( full => 1, ) : ( offset => $fmt->{offset} || 0, length => (exists $fmt->{length} ? $fmt->{length}||0 : 'max'), ), }; } $param->{hashify} = sub { $class->_hashify(\@F, @_) }; } die "${class}\->${method}: is_replica must be a SCALARREF" if exists $param->{is_replica} && ref $param->{is_replica} ne 'SCALAR'; my $is_rep = delete $param->{is_replica}; $$is_rep = 0 if $is_rep; my $self = $class->instance; my @rep = $is_rep ? @{ $self->{replicas} } : (); my ($ret,@ret); for(my $box = $self->{box}; $box; $box = shift @rep) { $self->{_last_box} = $box; if(wantarray) { @ret = $box->$method(@args, $param); } elsif(defined wantarray) { $ret = $box->$method(@args, $param); } else { $box->$method(@args, $param); } last if !$box->Error or !$is_rep or !@rep; ++$$is_rep; } return wantarray ? @ret : $ret; }; } } =pod =head3 B, B Return error code or description (see ). =cut sub Error { my ($class, @args) = @_; $class->instance->{_last_box}->Error(@args); } sub ErrorStr { my ($class, @args) = @_; $class->instance->{_last_box}->ErrorStr(@args); } =pod =head1 LICENCE AND COPYRIGHT This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 SEE ALSO L L =cut 1; MR-Tarantool-0.0.24/lib/MR/Tarantool/Box.pm0000644000175000017500000015405011764357262021351 0ustar nevinitsinnevinitsinpackage MR::Tarantool::Box; =pod =head1 NAME MR::Tarantool::Box - A driver for an efficient Tarantool/Box NoSQL in-memory storage. =head1 SYNOPSIS my $box = MR::Tarantool::Box->new({ servers => "127.0.0.1:33013", name => "My Box", # mostly used for debug purposes spaces => [ { indexes => [ { index_name => 'idx1', keys => [0], }, { 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, $ 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 }, { #... } ], default_space => "primary", timeout => 1.0, # seconds retry => 3, debug => 9, # output to STDERR some debugging info raise => 0, # dont raise an exception in case of error }); my $bool = $box->Insert(1, 2,3, 4,5,6,7,8,"asdf") or die $box->ErrorStr; my $bool = $box->Insert(2, 2,4, 4,5,6,7,8,"asdf",{space => "primary"}) or die $box->ErrorStr; my $tuple = $box->Insert(3, 3,3, 4,5,6,7,8,"asdf",{want_inserted_tuple => 1}) or die $box->ErrorStr; # Select by single-field key my $tuple = $box->Select(1); # scalar context - scalar result: $tuple my @tuples = $box->Select(1,2,3); # list context - list result: ($tuple, $tuple, ...) my $tuples = $box->Select([1,2,3],{space => "primary", use_index => "idx1"}); # arrayref result: [$tuple, $tuple, ...] # Select by multi-field key my $tuples = $box->Select([[2,3]],{use_index => "idx2"}); # by full key my $tuples = $box->Select([[2]] ,{use_index => "idx2"}); # by partial key my $bool = $box->UpdateMulti(1,[ f4 => add => 3 ]); my $bool = $box->UpdateMulti(2,[ f4 => add => 3 ],{space => "primary"}); my $tuple = $box->UpdateMulti(3,[ f4 => add => 3 ],{want_updated_tuple => 1}); my $bool = $box->Delete(1); my $tuple = $box->Delete(2, {want_deleted_tuple => 1}); =head1 DESCRIPTION =head2 METHODS =cut use strict; 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 (); use constant { WANT_RESULT => 1, INSERT_ADD => 2, INSERT_REPLACE => 4, }; sub IPROTOCLASS () { 'MR::IProto' } use vars qw/$VERSION %ERRORS/; $VERSION = 0.0.24; BEGIN { *confess = \&MR::IProto::confess } %ERRORS = ( 0x00000000 => q{OK}, 0x00000100 => q{Non master connection, but it should be}, 0x00000200 => q{Illegal parametrs}, 0x00000300 => q{Uid not from this storage range}, 0x00000400 => q{Tuple is marked as read-only}, 0x00000500 => q{Tuple isn't locked}, 0x00000600 => q{Tuple is locked}, 0x00000700 => q{Failed to allocate memory}, 0x00000800 => q{Bad integrity}, 0x00000a00 => q{Unsupported command}, 0x00000b00 => q{Can't do select}, 0x00001800 => q{Can't register new user}, 0x00001a00 => q{Can't generate alert id}, 0x00001b00 => q{Can't del node}, 0x00001c00 => q{User isn't registered}, 0x00001d00 => q{Syntax error in query}, 0x00001e00 => q{Unknown field}, 0x00001f00 => q{Number value is out of range}, 0x00002000 => q{Insert already existing object}, 0x00002200 => q{Can not order result}, 0x00002300 => q{Multiple update/delete forbidden}, 0x00002400 => q{Nothing affected}, 0x00002500 => q{Primary key update forbidden}, 0x00002600 => q{Incorrect protocol version}, 0x00002700 => q{WAL failed}, 0x00003000 => q{Procedure return type is not supported in the binary protocol}, 0x00003100 => q{Tuple doesn't exist}, 0x00003200 => q{Procedure is not defined}, 0x00003300 => q{Lua error}, 0x00003400 => q{Space is disabled}, 0x00003500 => q{No such index in space}, 0x00003600 => q{Field was not found in the tuple}, 0x00003700 => q{Tuple already exists}, 0x00003800 => q{Duplicate key exists in a unique index}, 0x00003900 => q{Space does not exists}, ); =pod =head3 new my $box = $class->new(\%args); %args: =over =item B => [ \%space, ... ] %space: =over =item B => $space_id_uint32 Space id as set in Tarantool/Box config. =item B => $space_name_string Self-descriptive space id, which will be mapped into C. =item B => $format_string C-compatible tuple format string, allowed formats: C, where C<&> stands for bytestring, C<$> stands for L string. C usable only if perl supports int64 itself. Tuples' fields are packed/unpacked according to this C. C<< * >> at the end of C enables L. =item B => B<$coderef> Specify a callback to turn each tuple into a good-looking hash. It receives C id and resultset as arguments. No return value needed. $coderef = sub { my ($space_id, $resultset) = @_; $_ = { FieldName1 => $_->[0], FieldName2 => $_->[1], ... } for @$resultset; }; =item B => B<$arrayref> Specify an arrayref of fields names according to C to turn each tuple into a good-looking hash. Names must begin with C<< [A-Za-z] >>. If L enabled, last field will be used to fold tailing fields. =item B => 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 enabled only. =item B => [ \%index, ... ] %index: =over =item B => $index_id_uint32 Index id as set in Tarantool/Box config within current C. If not set, order position in C is theated as C. =item B => $index_name_string Self-descriptive index id, which will be mapped into C. =item B => [ $field_no_uint32, ... ] Properly ordered arrayref of fields' numbers which are indexed. =back =item B => $default_index_name_string_or_id_uint32 Index C or C to be used by default for the current C in B