use utf8;
use strict;
use warnings;
package DR::Tarantool::StartTest;
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;
use POSIX ();
=head1 NAME
DR::Tarantool::StartTest - finds and starts Tarantool on free port.
=head1 SYNOPSIS
my $t = run DR::Tarantool::StartTest ( 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
Return true if Tarantool is found and started
=cut
sub started {
my ($self) = @_;
return $self->{started};
}
=head2 log
Return 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 _start_tarantool {
my ($self) = @_;
if ($ENV{TARANTOOL_TEMPDIR}) {
$self->{temp} = $ENV{TARANTOOL_TEMPDIR};
$self->{dont_unlink_temp} = 1;
rmtree $self->{temp} if -d $self->{temp};
mkdir $self->{temp};
} else {
$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->{core} = catfile $self->{temp}, 'core';
$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->{box} = $ENV{TARANTOOL_BOX} || 'tarantool_box';
$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, '>:encoding(UTF-8)', $self->{cfg};
print $fh $self->{config_body};
close $fh;
chdir $self->{temp};
system "$self->{box} -c $self->{cfg} --check-config >> $self->{log} 2>&1";
goto EXIT if $?;
system "$self->{box} -c $self->{cfg} --init-storage ".
">> $self->{log} 2>&1";
goto EXIT if $?;
$self->_restart;
EXIT:
chdir $self->{cwd};
}
sub _restart {
my ($self) = @_;
unless ($self->{child} = fork) {
chdir $self->{temp};
die "Can't fork: $!" unless defined $self->{child};
POSIX::setsid();
exec "ulimit -c unlimited; ".
"exec $self->{box} -c $self->{cfg} >> $self->{log} 2>&1";
die "Can't start $self->{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;
}
}
sub restart {
my ($self) = @_;
$self->kill('KILL');
$self->_restart;
}
=head2 primary_port
Return Tarantool primary port
=cut
sub primary_port { return $_[0]->{primary_port} }
=head2 admin_port
Return Tarantool admin port
=cut
sub admin_port { return $_[0]->{admin_port} }
=head2 tarantool_pid
Return B<PID>
=cut
sub tarantool_pid { return $_[0]->{child} }
=head2 kill
Kills Tarantool
=cut
sub kill :method {
my ($self, $signame) = @_;
$signame ||= 'TERM';
if ($self->{child}) {
kill $signame => $self->{child};
waitpid $self->{child}, 0;
delete $self->{child};
}
$self->{started} = 0;
}
=head2 is_dead
Return true if child Tarantool process is dead.
=cut
sub is_dead {
my ($self) = @_;
return 1 unless $self->{child};
return 0 if 0 < kill 0 => $self->{child};
return 1;
}
=head2 DESTROY
Destructor. Kills tarantool, removes temporary files.
=cut
sub DESTROY {
my ($self) = @_;
local $?;
chdir $self->{cwd};
return unless $self->{master} == $$;
if (-r $self->{core}) {
warn "Tarantool was coredumped\n" if -r $self->{core};
system "echo bt|gdb $self->{box} $self->{core}";
}
$self->kill;
rmtree $self->{temp} if $self->{temp} and !$self->{dont_unlink_temp};
}
sub temp_dir {
my ($self) = @_;
return $self->{temp};
}
sub clean_xlogs {
my ($self) = @_;
return unless $self->{temp};
my @xlogs = glob catfile $self->{temp}, '*.xlog';
unlink for @xlogs;
}
{
my %busy_ports;
sub _find_free_port {
while( 1 ) {
my $port = 10000 + int rand 30000;
next if exists $busy_ports{ $port };
next unless IO::Socket::INET->new(
Listen => 5,
LocalAddr => '127.0.0.1',
LocalPort => $port,
Proto => 'tcp',
(($^O eq 'MSWin32') ? () : (ReuseAddr => 1)),
);
return $busy_ports{ $port } = $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;