test environment for balancer

connector/perl/lib/MR/IProto/Cluster.pm

@@ -13,7 +13,14 @@ This class is used to implement balancing between several servers.
 use Mouse;
 use Mouse::Util::TypeConstraints;
 use MR::IProto::Cluster::Server;
-use String::CRC32 qw(crc32);
+
+BEGIN {
+    eval "use String::CRC32 qw(crc32)";
+    if ($@) {
+        eval "use Digest::CRC 'crc32'";
+        die $@ if $@;
+    }
+}
 
 =head1 EXPORTED CONSTANTS
 

connector/perl/lib/Test/Tarantool.pm

+use warnings;
+use strict;
+use utf8;
+
+package Test::Tarantool;
+use Carp;
+use File::Temp qw(tempfile tempdir);
+use File::Path 'rmtree';
+use File::Spec::Functions qw(catfile rel2abs);
+use Cwd;
+use IO::Socket::INET;
+
+=head1 NAME
+
+Test::Tarantool - finds and starts tarantool on free port.
+
+=head1 SYNOPSIS
+
+my $t = run Test::Tarantool ( cfg => $file_spaces_cfg );
+
+=head1 DESCRIPTION
+
+The module tries to find and then to start B<tarantool_box>.
+
+The module is used inside tests.
+
+
+=head1 METHODS
+
+=head2 run
+
+Constructor. Receives the following arguments:
+
+=over
+
+=item cfg
+
+path to tarantool.cfg
+
+=back
+
+=cut
+
+
+sub run {
+    my ($module, %opts) = @_;
+
+    my $cfg_file = delete $opts{cfg} or croak "config file not defined";
+    croak "File not found" unless -r $cfg_file;
+    open my $fh, '<:encoding(UTF-8)', $cfg_file or die "$@\n";
+    local $/;
+    my $cfg = <$fh>;
+
+    my %self = (
+        admin_port => $module->_find_free_port,
+        primary_port => $module->_find_free_port,
+        secondary_port => $module->_find_free_port,
+        cfg_data => $cfg,
+        master => $$,
+        cwd => getcwd,
+        add_opts => \%opts
+    );
+
+    $opts{script_dir} = rel2abs $opts{script_dir} if $opts{script_dir};
+
+    my $self = bless \%self => $module;
+    $self->_start_tarantool;
+    $self;
+}
+
+
+=head2 started
+
+Returns true if tarantool is found and started
+
+=cut
+
+sub started {
+    my ($self) = @_;
+    return $self->{started};
+}
+
+
+=head2 log
+
+Returns tarantool logs
+
+=cut
+
+sub log {
+    my ($self) = @_;
+    return '' unless $self->{log} and -r $self->{log};
+    open my $fh, '<encoding(UTF-8)', $self->{log};
+    local $/;
+    my $l = <$fh>;
+    return $l;
+}
+
+
+sub config_body {
+    my ($self) = @_;
+    return $self->{config_body} || '';
+}
+
+sub _start_tarantool {
+    my ($self) = @_;
+    $self->{temp} = tempdir;
+    $self->{cfg} = catfile $self->{temp}, 'tarantool.cfg';
+    $self->{log} = catfile $self->{temp}, 'tarantool.log';
+    $self->{pid} = catfile $self->{temp}, 'tarantool.pid';
+
+
+
+    $self->{config_body} = $self->{cfg_data};
+    $self->{config_body} .= "\n\n";
+    $self->{config_body} .= "slab_alloc_arena = 1.1\n";
+    $self->{config_body} .= sprintf "pid_file = %s\n", $self->{pid};
+
+    $self->{config_body} .= sprintf "%s = %s\n", $_, $self->{$_}
+        for (qw(admin_port primary_port secondary_port));
+
+    $self->{config_body} .= sprintf qq{logger = "cat > %s"\n}, $self->{log};
+
+    for (keys %{ $self->{add_opts} }) {
+        my $v = $self->{add_opts}{ $_ };
+
+        if ($v =~ /^\d+$/) {
+            $self->{config_body} .= sprintf qq{%s = %s\n}, $_, $v;
+        } else {
+            $self->{config_body} .= sprintf qq{%s = "%s"\n}, $_, $v;
+        }
+    }
+
+    return unless open my $fh, '>:raw', $self->{cfg};
+    print $fh $self->{config_body};
+    close $fh;
+
+    chdir $self->{temp};
+
+    system "tarantool_box -c $self->{cfg} --check-config > $self->{log} 2>&1";
+    goto EXIT if $?;
+
+    system "tarantool_box -c $self->{cfg} --init-storage >> $self->{log} 2>&1";
+    goto EXIT if $?;
+
+    unless ($self->{child} = fork) {
+        exec "tarantool_box -c $self->{cfg}";
+        die "Can't start tarantool_box: $!\n";
+    }
+
+    $self->{started} = 1;
+
+
+    # wait for starting tarantool
+    for (my $i = 0; $i < 100; $i++) {
+        last if IO::Socket::INET->new(
+            PeerAddr => '127.0.0.1', PeerPort => $self->primary_port
+        );
+
+        sleep 0.01;
+    }
+
+    EXIT:
+        chdir $self->{cwd};
+}
+
+
+=head2 primary_port
+
+Returns tarantool primary port
+
+=cut
+
+sub primary_port { return $_[0]->{primary_port} }
+
+
+=head2 tarantool_pid
+
+Returns B<PID>
+
+=cut
+
+sub tarantool_pid { return $_[0]->{child} }
+
+
+=head2 kill
+
+Kills tarantool
+
+=cut
+
+sub kill :method {
+    my ($self) = @_;
+
+    if ($self->{child}) {
+        kill 'TERM' => $self->{child};
+        waitpid $self->{child}, 0;
+        delete $self->{child};
+    }
+}
+
+=head2 DESTROY
+
+Destructor. Kills tarantool, removes temporary files.
+
+=cut
+
+sub DESTROY {
+    my ($self) = @_;
+    return unless $self->{master} == $$;
+    $self->kill;
+    rmtree $self->{temp} if $self->{temp};
+}
+
+{
+    my $start_port;
+
+    sub _find_free_port {
+        $start_port = 10000 unless defined $start_port;
+
+        while( ++$start_port < 60000 ) {
+            return $start_port if IO::Socket::INET->new(
+                Listen => 5,
+                LocalAddr => '127.0.0.1',
+                LocalPort => $start_port,
+                Proto => 'tcp',
+                (($^O eq 'MSWin32') ? () : (ReuseAddr => 1)),
+            );
+        }
+
+        croak "Can't find free port";
+    }
+}
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2011 Dmitry E. Oboukhov <unera@debian.org>
+Copyright (C) 2011 Roman V. Nikolaev <rshadow@rambler.ru>
+
+This program is free software, you can redistribute it and/or
+modify it under the terms of the Artistic License.
+
+=head1 VCS
+
+The project is placed git repo on github:
+L<https://github.com/unera/dr-tarantool/>.
+
+=cut
+
+1;

connector/perl/t/01-test-tarantool.t

+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use utf8;
+use open qw(:std :utf8);
+use lib qw(lib ../lib);
+
+use Test::More tests    => 9;
+use Encode qw(decode encode);
+
+
+BEGIN {
+    # Подготовка объекта тестирования для работы с utf8
+    my $builder = Test::More->builder;
+    binmode $builder->output,         ":utf8";
+    binmode $builder->failure_output, ":utf8";
+    binmode $builder->todo_output,    ":utf8";
+
+    use_ok 'Test::Tarantool';
+    use_ok 'File::Spec::Functions', 'catfile';
+    use_ok 'File::Basename', 'dirname';
+}
+
+
+my $data_dir = catfile dirname(__FILE__), 'data';
+ok -d $data_dir, "-d $data_dir";
+
+my $cfg = catfile $data_dir, 'tnt.cfg';
+
+
+ok -r $cfg, "-r $cfg";
+
+my $t1 = Test::Tarantool->run(cfg => $cfg, script_dir => $data_dir);
+my $t2 = Test::Tarantool->run(cfg => $cfg, script_dir => $data_dir);
+
+
+
+ok $t1, 'test tarantool 1';
+ok $t2, 'test tarantool 2';
+ok $t1->started, 'tarantool 1 is started';
+ok $t2->started, 'tarantool 2 is started';
+

connector/perl/t/02-two-servers.t

+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use utf8;
+use open qw(:std :utf8);
+use lib qw(lib ../lib);
+
+use Test::More tests    => 17;
+use Encode qw(decode encode);
+
+
+BEGIN {
+    # Подготовка объекта тестирования для работы с utf8
+    my $builder = Test::More->builder;
+    binmode $builder->output,         ":utf8";
+    binmode $builder->failure_output, ":utf8";
+    binmode $builder->todo_output,    ":utf8";
+
+    use_ok 'Test::Tarantool';
+    use_ok 'File::Spec::Functions', 'catfile';
+    use_ok 'File::Basename', 'dirname';
+    use_ok 'MR::Tarantool::Box';
+    use_ok 'Time::HiRes', 'time';
+}
+
+
+my $data_dir = catfile dirname(__FILE__), 'data';
+ok -d $data_dir, "-d $data_dir";
+
+my $cfg = catfile $data_dir, 'tnt.cfg';
+
+
+ok -r $cfg, "-r $cfg";
+
+my $t1 = Test::Tarantool->run(cfg => $cfg, script_dir => $data_dir);
+my $t2 = Test::Tarantool->run(cfg => $cfg, script_dir => $data_dir);
+
+
+
+ok $t1, 'test tarantool 1';
+ok $t2, 'test tarantool 2';
+ok $t1->started, 'tarantool 1 is started';
+ok $t2->started, 'tarantool 2 is started';
+
+my $spaces =  [
+        {
+            indexes => [
+                {
+                    index_name => 'i0',
+                    keys    => [ 0 ]
+                },
+                {
+                    index_name => 'i1',
+                    keys    => [ 1 ]
+                },
+                {
+                    index_name => 'i2',
+                    keys    => [ 2 ]
+                },
+            ],
+
+            default_index => 'i0',
+            fields => [ 'id', 'name', 'value' ],
+            space  => 0,
+            name   => 'test',
+            format => 'L$L'
+        }
+    ]
+;
+
+
+
+my $box1 = MR::Tarantool::Box->new({
+    servers => '127.0.0.1:' . $t1->primary_port,
+    name    => 'Test1',
+    spaces  => $spaces
+});
+
+$box1->Insert(1, 'first', 1);
+$box1->Call(tst_rand_init => [], { unpack_format => '$'});
+
+my $box2 = MR::Tarantool::Box->new({
+    servers => '127.0.0.1:' . $t2->primary_port,
+    name    => 'Test1',
+    spaces  => $spaces
+});
+
+$box2->Insert(1, 'second', 1);
+$box2->Call(tst_rand_init => [], { unpack_format => '$'});
+
+
+my $box_union = MR::Tarantool::Box->new({
+    servers => join(',',
+        '127.0.0.1:' . $t1->primary_port,
+        '127.0.0.1:' . $t2->primary_port
+    ),
+    name    => 'Test',
+    spaces  => $spaces
+});
+
+ok $box_union, 'connector is created';
+ok $box1, 'connector is created';
+ok $box2, 'connector is created';
+
+my %resps;
+for (1 .. 2) {
+    my $tuples = $box_union->Call(tst_sleep => [], { unpack_format => '$$' });
+    $resps{ $tuples->[0][0] }++;
+}
+
+ok exists $resps{first}, 'first server was used';
+ok exists $resps{second}, 'second server was used';
+
+
+%resps = ();
+for (1 .. 100) {
+    my $started = time;
+    my $tuples = $box_union->Call(tst_sleep => [], { unpack_format => '$$' });
+    my $done = time - $started;
+
+    if ($done <= .3) {
+        $resps{ok}++;
+    } else {
+        $resps{fail}++;
+    }
+}
+
+ok $resps{fail} < $resps{ok} / 8, 'random fails';
+

connector/perl/t/data/init.lua

+function tst_sleep( )
+    
+    local tuple = box.select( 0, 0, box.pack('i', 1) )
+    if tuple == nil then
+        return { 'unknown', '0.0' }
+    end
+
+    local delay = 0.01 * math.random()
+    if math.random(1000) > 100 then
+        box.fiber.sleep(delay)
+    else
+        box.fiber.sleep(.3)
+        delay = 1
+    end
+    return { tuple[1], string.format('%f', delay) }
+
+end
+
+function tst_rand_init()
+    math.randomseed( os.time() )
+end

connector/perl/t/data/tnt.cfg

+#
+# Limit of memory used to store tuples to 100MB
+# (0.1 GB)
+# This effectively limits the memory, used by
+# Tarantool. However, index and connection memory
+# is stored outside the slab allocator, hence
+# the effective memory usage can be higher (sometimes
+# twice as high).
+#
+slab_alloc_arena = 0.1
+
+#
+# Read only and read-write port.
+primary_port = 33013
+
+# Read-only port.
+secondary_port = 33014
+
+#
+# The port for administrative commands.
+#
+admin_port = 33015
+
+
+#
+# Each write ahead log contains this many rows.
+# When the limit is reached, Tarantool closes
+# the WAL and starts a new one.
+rows_per_wal = 50000
+
+# Define a simple space with 1 HASH-based
+# primary key.
+space[0].enabled = 1
+space[0].index[0].type = "HASH"
+space[0].index[0].unique = 1
+space[0].index[0].key_field[0].fieldno = 0
+space[0].index[0].key_field[0].type = "NUM"
+
+
+space[0].index[1].type = "TREE"
+space[0].index[1].unique = 0
+space[0].index[1].key_field[0].fieldno = 1
+space[0].index[1].key_field[0].type = "STR"
+
+space[0].index[2].type = "TREE"
+space[0].index[2].unique = 0
+space[0].index[2].key_field[0].fieldno = 2
+space[0].index[2].key_field[0].type = "NUM"