From 9b7d7e128ed801349d5905c82a85d03ced18e423 Mon Sep 17 00:00:00 2001
From: "Dmitry E. Oboukhov" <unera@debian.org>
Date: Thu, 28 Jun 2012 18:05:41 +0400
Subject: [PATCH] test environment for balancer
---
connector/perl/lib/MR/IProto/Cluster.pm | 9 +-
connector/perl/lib/Test/Tarantool.pm | 250 ++++++++++++++++++++++++
connector/perl/t/01-test-tarantool.t | 43 ++++
connector/perl/t/02-two-servers.t | 130 ++++++++++++
connector/perl/t/data/init.lua | 21 ++
connector/perl/t/data/tnt.cfg | 48 +++++
6 files changed, 500 insertions(+), 1 deletion(-)
create mode 100644 connector/perl/lib/Test/Tarantool.pm
create mode 100644 connector/perl/t/01-test-tarantool.t
create mode 100644 connector/perl/t/02-two-servers.t
create mode 100644 connector/perl/t/data/init.lua
create mode 100644 connector/perl/t/data/tnt.cfg
diff --git a/connector/perl/lib/MR/IProto/Cluster.pm b/connector/perl/lib/MR/IProto/Cluster.pm
index d5f46b8bde..a966c16bb1 100644
--- a/connector/perl/lib/MR/IProto/Cluster.pm
+++ b/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
diff --git a/connector/perl/lib/Test/Tarantool.pm b/connector/perl/lib/Test/Tarantool.pm
new file mode 100644
index 0000000000..14aecb0b9d
--- /dev/null
+++ b/connector/perl/lib/Test/Tarantool.pm
@@ -0,0 +1,250 @@
+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;
diff --git a/connector/perl/t/01-test-tarantool.t b/connector/perl/t/01-test-tarantool.t
new file mode 100644
index 0000000000..1fbdcdae11
--- /dev/null
+++ b/connector/perl/t/01-test-tarantool.t
@@ -0,0 +1,43 @@
+#!/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';
+
diff --git a/connector/perl/t/02-two-servers.t b/connector/perl/t/02-two-servers.t
new file mode 100644
index 0000000000..3383b1f469
--- /dev/null
+++ b/connector/perl/t/02-two-servers.t
@@ -0,0 +1,130 @@
+#!/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';
+
diff --git a/connector/perl/t/data/init.lua b/connector/perl/t/data/init.lua
new file mode 100644
index 0000000000..d5335b60df
--- /dev/null
+++ b/connector/perl/t/data/init.lua
@@ -0,0 +1,21 @@
+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
diff --git a/connector/perl/t/data/tnt.cfg b/connector/perl/t/data/tnt.cfg
new file mode 100644
index 0000000000..e25ff0a734
--- /dev/null
+++ b/connector/perl/t/data/tnt.cfg
@@ -0,0 +1,48 @@
+#
+# 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"
--
GitLab