line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
11
|
|
|
11
|
|
101184
|
use utf8; |
|
11
|
|
|
|
|
18
|
|
|
11
|
|
|
|
|
61
|
|
2
|
11
|
|
|
11
|
|
278
|
use strict; |
|
11
|
|
|
|
|
12
|
|
|
11
|
|
|
|
|
259
|
|
3
|
11
|
|
|
11
|
|
39
|
use warnings; |
|
11
|
|
|
|
|
12
|
|
|
11
|
|
|
|
|
333
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package DR::Tarantool::StartTest; |
6
|
11
|
|
|
11
|
|
44
|
use Carp; |
|
11
|
|
|
|
|
12
|
|
|
11
|
|
|
|
|
741
|
|
7
|
11
|
|
|
11
|
|
7823
|
use File::Temp qw(tempfile tempdir); |
|
11
|
|
|
|
|
174792
|
|
|
11
|
|
|
|
|
679
|
|
8
|
11
|
|
|
11
|
|
63
|
use File::Path 'rmtree'; |
|
11
|
|
|
|
|
14
|
|
|
11
|
|
|
|
|
414
|
|
9
|
11
|
|
|
11
|
|
2627
|
use File::Spec::Functions qw(catfile rel2abs); |
|
11
|
|
|
|
|
3778
|
|
|
11
|
|
|
|
|
615
|
|
10
|
11
|
|
|
11
|
|
59
|
use Cwd; |
|
11
|
|
|
|
|
13
|
|
|
11
|
|
|
|
|
489
|
|
11
|
11
|
|
|
11
|
|
5420
|
use IO::Socket::INET; |
|
11
|
|
|
|
|
99752
|
|
|
11
|
|
|
|
|
63
|
|
12
|
11
|
|
|
11
|
|
10199
|
use POSIX (); |
|
11
|
|
|
|
|
50585
|
|
|
11
|
|
|
|
|
279
|
|
13
|
11
|
|
|
11
|
|
2412
|
use List::MoreUtils 'any'; |
|
11
|
|
|
|
|
4037
|
|
|
11
|
|
|
|
|
24188
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 NAME |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
DR::Tarantool::StartTest - finds and starts Tarantool on free port. |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 SYNOPSIS |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $t = run DR::Tarantool::StartTest ( cfg => $file_spaces_cfg ); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 DESCRIPTION |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
The module tries to find and then to start B. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
The module is used inside tests. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 METHODS |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head2 run |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
Constructor. Receives the following arguments: |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=over |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=item cfg |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
path to tarantool.cfg |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=back |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=cut |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub compare_versions($$) { |
49
|
0
|
|
|
0
|
0
|
0
|
my ($v1, $v2) = @_; |
50
|
0
|
|
|
|
|
0
|
my @v1 = split /\./, $v1; |
51
|
0
|
|
|
|
|
0
|
my @v2 = split /\./, $v2; |
52
|
|
|
|
|
|
|
|
53
|
0
|
0
|
|
|
|
0
|
for (0 .. (@v1 < @v2 ? $#v1 : $#v2)) { |
54
|
0
|
0
|
|
|
|
0
|
return 'gt' if $v1[$_] > $v2[$_]; |
55
|
0
|
0
|
|
|
|
0
|
return 'lt' if $v1[$_] < $v2[$_]; |
56
|
|
|
|
|
|
|
} |
57
|
0
|
0
|
|
|
|
0
|
return 'gt' if @v1 > @v2; |
58
|
0
|
0
|
|
|
|
0
|
return 'lt' if @v1 < @v2; |
59
|
0
|
|
|
|
|
0
|
return 'eq'; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head2 is_version(VERSION[, FAMILY]) |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
return true if tarantool_box is found and its version is more than L. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
FAMILY can be: |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=over |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=item B<1> (default) |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
For tarantool < 1.6. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=item B<2> |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
For tarantool >= 1.6. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=back |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=cut |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub is_version($;$) { |
84
|
9
|
|
|
9
|
1
|
418
|
my ($version, $family) = @_; |
85
|
|
|
|
|
|
|
|
86
|
9
|
|
|
|
|
13
|
my $box; |
87
|
9
|
|
100
|
|
|
41
|
$family ||= 1; |
88
|
|
|
|
|
|
|
|
89
|
9
|
50
|
|
9
|
|
78
|
croak "Unknown family: $family" unless any { $family == $_ } 1, 2; |
|
9
|
|
|
|
|
30
|
|
90
|
|
|
|
|
|
|
|
91
|
9
|
50
|
|
|
|
38
|
if ($family == 1) { |
92
|
9
|
|
50
|
|
|
53
|
$box = $ENV{TARANTOOL_BOX} || 'tarantool_box'; |
93
|
|
|
|
|
|
|
} else { |
94
|
0
|
|
0
|
|
|
0
|
$box = $ENV{TARANTOOL_BOX} || 'tarantool'; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
9
|
|
|
|
|
10
|
my $str; |
98
|
|
|
|
|
|
|
{ |
99
|
9
|
|
|
0
|
|
10
|
local $SIG{__WARN__} = sub { }; |
|
9
|
|
|
|
|
52
|
|
|
0
|
|
|
|
|
0
|
|
100
|
9
|
|
|
|
|
17132
|
$str = `$box -V`; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
9
|
50
|
|
|
|
1796
|
return 0 unless $str; |
104
|
0
|
0
|
|
|
|
0
|
return 0 if $str =~ /^tarantool client, version/; |
105
|
0
|
|
|
|
|
0
|
my ($vt) = $str =~ /^Tarantool:?\s+(\d(?:\.\d+)+).*\s*$/s; |
106
|
0
|
0
|
|
|
|
0
|
return 0 unless $vt; |
107
|
0
|
|
|
|
|
0
|
my $res = compare_versions $version, $vt; |
108
|
0
|
0
|
|
0
|
|
0
|
return 0 unless any { $_ eq $res } 'eq', 'lt'; |
|
0
|
|
|
|
|
0
|
|
109
|
0
|
|
|
|
|
0
|
return 1; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub run { |
113
|
4
|
|
|
4
|
1
|
3447
|
my ($module, %opts) = @_; |
114
|
|
|
|
|
|
|
|
115
|
4
|
50
|
|
|
|
23
|
my $cfg_file = delete $opts{cfg} or croak "config file not defined"; |
116
|
4
|
50
|
|
|
|
58
|
croak "File not found" unless -r $cfg_file; |
117
|
4
|
50
|
|
4
|
|
121
|
open my $fh, '<:encoding(UTF-8)', $cfg_file or die "$@\n"; |
|
4
|
|
|
|
|
21
|
|
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
21
|
|
118
|
4
|
|
|
|
|
4523
|
local $/; |
119
|
4
|
|
|
|
|
93
|
my $cfg = <$fh>; |
120
|
|
|
|
|
|
|
|
121
|
4
|
|
50
|
|
|
195
|
my $family = $opts{family} || 1; |
122
|
4
|
50
|
|
4
|
|
57
|
croak "Unknown family: $family" unless any { $family == $_ } 1, 2; |
|
4
|
|
|
|
|
14
|
|
123
|
|
|
|
|
|
|
|
124
|
4
|
|
|
|
|
34
|
my %self = ( |
125
|
|
|
|
|
|
|
admin_port => $module->_find_free_port, |
126
|
|
|
|
|
|
|
primary_port => $module->_find_free_port, |
127
|
|
|
|
|
|
|
secondary_port => $module->_find_free_port, |
128
|
|
|
|
|
|
|
cfg_data => $cfg, |
129
|
|
|
|
|
|
|
master => $$, |
130
|
|
|
|
|
|
|
cwd => getcwd, |
131
|
|
|
|
|
|
|
add_opts => \%opts, |
132
|
|
|
|
|
|
|
family => $family, |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
|
135
|
4
|
100
|
|
|
|
21
|
$opts{script_dir} = rel2abs $opts{script_dir} if $opts{script_dir}; |
136
|
|
|
|
|
|
|
|
137
|
4
|
|
|
|
|
43
|
my $self = bless \%self => $module; |
138
|
4
|
|
|
|
|
15
|
$self->_start_tarantool; |
139
|
0
|
|
|
|
|
0
|
$self; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
sub family { |
144
|
12
|
|
|
12
|
0
|
16
|
my ($self) = @_; |
145
|
12
|
|
|
|
|
41
|
return $self->{family}; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=head2 started |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
Return true if Tarantool is found and started |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=cut |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub started { |
156
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
157
|
0
|
|
|
|
|
0
|
return $self->{started}; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head2 log |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
Return Tarantool logs |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=cut |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub log { |
168
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
169
|
0
|
0
|
0
|
|
|
0
|
return '' unless $self->{log} and -r $self->{log}; |
170
|
0
|
|
|
|
|
0
|
open my $fh, '{log}; |
171
|
0
|
|
|
|
|
0
|
local $/; |
172
|
0
|
|
|
|
|
0
|
my $l = <$fh>; |
173
|
0
|
|
|
|
|
0
|
return $l; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub admin { |
177
|
0
|
|
|
0
|
0
|
0
|
my ($self, @cmd) = @_; |
178
|
0
|
|
|
|
|
0
|
$cmd[-1] =~ s/\s*$/\n/; |
179
|
0
|
|
|
|
|
0
|
my $cmd = join ' ' => @cmd; |
180
|
|
|
|
|
|
|
|
181
|
0
|
0
|
|
|
|
0
|
my $s = IO::Socket::INET->new( |
182
|
|
|
|
|
|
|
PeerHost => '127.0.0.1', |
183
|
|
|
|
|
|
|
PeerPort => $self->admin_port, |
184
|
|
|
|
|
|
|
Proto => 'tcp', |
185
|
|
|
|
|
|
|
(($^O eq 'MSWin32') ? () : (ReuseAddr => 1)), |
186
|
|
|
|
|
|
|
); |
187
|
|
|
|
|
|
|
|
188
|
0
|
0
|
|
|
|
0
|
croak "Can't connect to admin port: $!" unless $s; |
189
|
0
|
|
|
|
|
0
|
print $s $cmd; |
190
|
0
|
|
|
|
|
0
|
my @lines; |
191
|
0
|
|
|
|
|
0
|
while(<$s>) { |
192
|
0
|
|
|
|
|
0
|
s/\s*$//; |
193
|
0
|
0
|
|
|
|
0
|
next if $_ eq '---'; |
194
|
0
|
0
|
|
|
|
0
|
last if $_ eq '...'; |
195
|
0
|
|
|
|
|
0
|
push @lines => $_; |
196
|
|
|
|
|
|
|
} |
197
|
0
|
|
|
|
|
0
|
close $s; |
198
|
0
|
|
|
|
|
0
|
return @lines; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub _start_tarantool { |
202
|
4
|
|
|
4
|
|
6
|
my ($self) = @_; |
203
|
4
|
50
|
|
|
|
14
|
if ($ENV{TARANTOOL_TEMPDIR}) { |
204
|
0
|
|
|
|
|
0
|
$self->{temp} = $ENV{TARANTOOL_TEMPDIR}; |
205
|
0
|
|
|
|
|
0
|
$self->{dont_unlink_temp} = 1; |
206
|
0
|
0
|
|
|
|
0
|
rmtree $self->{temp} if -d $self->{temp}; |
207
|
0
|
|
|
|
|
0
|
mkdir $self->{temp}; |
208
|
|
|
|
|
|
|
} else { |
209
|
4
|
|
|
|
|
18
|
$self->{temp} = tempdir; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
4
|
50
|
|
|
|
1967
|
if ($self->family) { |
213
|
4
|
|
|
|
|
30
|
$self->{cfg} = catfile $self->{temp}, 'tarantool.cfg'; |
214
|
|
|
|
|
|
|
} else { |
215
|
0
|
|
|
|
|
0
|
$self->{cfg} = catfile $self->{temp}, 'box.lua'; |
216
|
|
|
|
|
|
|
} |
217
|
4
|
|
|
|
|
23
|
$self->{log} = catfile $self->{temp}, 'tarantool.log'; |
218
|
4
|
|
|
|
|
21
|
$self->{pid} = catfile $self->{temp}, 'tarantool.pid'; |
219
|
4
|
|
|
|
|
19
|
$self->{core} = catfile $self->{temp}, 'core'; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
|
223
|
4
|
50
|
|
|
|
11
|
if ($self->family == 1) { |
224
|
4
|
50
|
|
|
|
10
|
croak "Available tarantool is not valid (is_version '1.4.0')" |
225
|
|
|
|
|
|
|
unless is_version '1.4.0', $self->family; |
226
|
|
|
|
|
|
|
} else { |
227
|
0
|
0
|
|
|
|
0
|
croak "Available tarantool is not valid (is_version '1.4.0')" |
228
|
|
|
|
|
|
|
unless is_version '1.6.0', $self->family; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
232
|
0
|
|
|
|
|
0
|
$self->{config_body} = $self->{cfg_data}; |
233
|
0
|
0
|
|
|
|
0
|
if ($self->family == 1) { |
234
|
0
|
|
|
|
|
0
|
$self->{config_body} .= "\n\n"; |
235
|
0
|
|
|
|
|
0
|
$self->{config_body} .= "slab_alloc_arena = 1.1\n"; |
236
|
0
|
|
|
|
|
0
|
$self->{config_body} .= sprintf "pid_file = %s\n", $self->{pid}; |
237
|
0
|
|
0
|
|
|
0
|
$self->{box} = $ENV{TARANTOOL_BOX} || 'tarantool_box'; |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
$self->{config_body} .= sprintf "%s = %s\n", $_, $self->{$_} |
240
|
0
|
|
|
|
|
0
|
for (qw(admin_port primary_port secondary_port)); |
241
|
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
0
|
$self->{config_body} .= |
243
|
|
|
|
|
|
|
sprintf qq{logger = "cat >> %s"\n}, $self->{log}; |
244
|
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
0
|
for (keys %{ $self->{add_opts} }) { |
|
0
|
|
|
|
|
0
|
|
246
|
0
|
|
|
|
|
0
|
my $v = $self->{add_opts}{ $_ }; |
247
|
|
|
|
|
|
|
|
248
|
0
|
0
|
|
|
|
0
|
if ($v =~ /^\d+$/) { |
249
|
0
|
|
|
|
|
0
|
$self->{config_body} .= sprintf qq{%s = %s\n}, $_, $v; |
250
|
|
|
|
|
|
|
} else { |
251
|
0
|
|
|
|
|
0
|
$self->{config_body} .= sprintf qq{%s = "%s"\n}, $_, $v; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
} else { |
255
|
0
|
|
0
|
|
|
0
|
$self->{box} = $ENV{TARANTOOL_BOX} || 'tarantool'; |
256
|
0
|
|
|
|
|
0
|
for ($self->{config_body}) { |
257
|
0
|
0
|
|
|
|
0
|
if (/admin_port\s*=/) { |
258
|
0
|
|
|
|
|
0
|
s{admin_port\s*=\s*['"]?\d+['"]} |
259
|
0
|
|
|
|
|
0
|
/admin_port = @{[$self->admin_port]}/; |
260
|
|
|
|
|
|
|
} else { |
261
|
0
|
|
|
|
|
0
|
s |
262
|
0
|
|
|
|
|
0
|
/$& admin_port = @{[$self->admin_port]},/; |
263
|
|
|
|
|
|
|
} |
264
|
0
|
0
|
|
|
|
0
|
if (/primary_port\s*=/) { |
265
|
0
|
|
|
|
|
0
|
s{primary_port\s*=\s*['"]?\d+['"]} |
266
|
0
|
|
|
|
|
0
|
/primary_port = @{[$self->primary_port]}/; |
267
|
|
|
|
|
|
|
} else { |
268
|
0
|
|
|
|
|
0
|
s |
269
|
0
|
|
|
|
|
0
|
/$& primary_port = @{[$self->primary_port]},/; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
0
|
0
|
|
|
|
0
|
return unless open my $fh, '>:encoding(UTF-8)', $self->{cfg}; |
275
|
0
|
|
|
|
|
0
|
print $fh $self->{config_body}; |
276
|
0
|
|
|
|
|
0
|
close $fh; |
277
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
0
|
chdir $self->{temp}; |
279
|
|
|
|
|
|
|
|
280
|
0
|
0
|
|
|
|
0
|
if ($self->family == 1) { |
281
|
0
|
|
|
|
|
0
|
system "$self->{box} -c $self->{cfg} ". |
282
|
|
|
|
|
|
|
"--check-config >> $self->{log} 2>&1"; |
283
|
0
|
0
|
|
|
|
0
|
goto EXIT if $?; |
284
|
|
|
|
|
|
|
|
285
|
0
|
|
|
|
|
0
|
system "$self->{box} -c $self->{cfg} --init-storage ". |
286
|
|
|
|
|
|
|
">> $self->{log} 2>&1"; |
287
|
0
|
0
|
|
|
|
0
|
goto EXIT if $?; |
288
|
|
|
|
|
|
|
} |
289
|
0
|
|
|
|
|
0
|
$self->_restart; |
290
|
0
|
|
|
|
|
0
|
EXIT: |
291
|
|
|
|
|
|
|
chdir $self->{cwd}; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub _restart { |
296
|
0
|
|
|
0
|
|
0
|
my ($self) = @_; |
297
|
|
|
|
|
|
|
|
298
|
0
|
0
|
|
|
|
0
|
unless ($self->{child} = fork) { |
299
|
0
|
|
|
|
|
0
|
chdir $self->{temp}; |
300
|
0
|
0
|
|
|
|
0
|
die "Can't fork: $!" unless defined $self->{child}; |
301
|
0
|
|
|
|
|
0
|
POSIX::setsid(); |
302
|
0
|
0
|
|
|
|
0
|
if ($self->family == 1) { |
303
|
0
|
|
|
|
|
0
|
exec "ulimit -c unlimited; ". |
304
|
|
|
|
|
|
|
"exec $self->{box} -c $self->{cfg} >> $self->{log} 2>&1"; |
305
|
|
|
|
|
|
|
} else { |
306
|
0
|
|
|
|
|
0
|
exec "ulimit -c unlimited; ". |
307
|
|
|
|
|
|
|
"exec $self->{box} $self->{cfg} >> $self->{log} 2>&1"; |
308
|
|
|
|
|
|
|
} |
309
|
0
|
|
|
|
|
0
|
die "Can't start $self->{box}: $!\n"; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
0
|
|
|
|
|
0
|
$self->{started} = 1; |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# wait for starting Tarantool |
316
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i < 100; $i++) { |
317
|
0
|
0
|
|
|
|
0
|
last if IO::Socket::INET->new( |
318
|
|
|
|
|
|
|
PeerAddr => '127.0.0.1', PeerPort => $self->primary_port |
319
|
|
|
|
|
|
|
); |
320
|
|
|
|
|
|
|
|
321
|
0
|
|
|
|
|
0
|
sleep 0.01; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i < 100; $i++) { |
325
|
0
|
0
|
|
|
|
0
|
last if $self->log =~ /entering event loop/; |
326
|
0
|
|
|
|
|
0
|
sleep 0.01; |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
|
329
|
0
|
0
|
|
|
|
0
|
sleep 1 unless $self->log =~ /entering event loop/; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
sub restart { |
333
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
334
|
0
|
|
|
|
|
0
|
$self->kill('KILL'); |
335
|
0
|
|
|
|
|
0
|
$self->_restart; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=head2 primary_port |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
Return Tarantool primary port |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=cut |
343
|
|
|
|
|
|
|
|
344
|
0
|
|
|
0
|
1
|
0
|
sub primary_port { return $_[0]->{primary_port} } |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=head2 admin_port |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
Return Tarantool admin port |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=cut |
352
|
|
|
|
|
|
|
|
353
|
0
|
|
|
0
|
1
|
0
|
sub admin_port { return $_[0]->{admin_port} } |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=head2 tarantool_pid |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
Return B |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=cut |
361
|
|
|
|
|
|
|
|
362
|
0
|
|
|
0
|
1
|
0
|
sub tarantool_pid { return $_[0]->{child} } |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
=head2 kill |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
Kills Tarantool |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=cut |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
sub kill :method { |
372
|
4
|
|
|
4
|
1
|
8
|
my ($self, $signame) = @_; |
373
|
|
|
|
|
|
|
|
374
|
4
|
|
50
|
|
|
34
|
$signame ||= 'TERM'; |
375
|
4
|
50
|
|
|
|
16
|
if ($self->{child}) { |
376
|
0
|
|
|
|
|
0
|
kill $signame => $self->{child}; |
377
|
0
|
|
|
|
|
0
|
waitpid $self->{child}, 0; |
378
|
0
|
|
|
|
|
0
|
delete $self->{child}; |
379
|
|
|
|
|
|
|
} |
380
|
4
|
|
|
|
|
19
|
$self->{started} = 0; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=head2 is_dead |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
Return true if child Tarantool process is dead. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=cut |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub is_dead { |
391
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
392
|
0
|
0
|
|
|
|
0
|
return 1 unless $self->{child}; |
393
|
0
|
0
|
|
|
|
0
|
return 0 if 0 < kill 0 => $self->{child}; |
394
|
0
|
|
|
|
|
0
|
return 1; |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=head2 DESTROY |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
Destructor. Kills tarantool, removes temporary files. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=cut |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
sub DESTROY { |
404
|
4
|
|
|
4
|
|
13
|
my ($self) = @_; |
405
|
4
|
|
|
|
|
30
|
local $?; |
406
|
4
|
|
|
|
|
71
|
chdir $self->{cwd}; |
407
|
4
|
50
|
|
|
|
36
|
return unless $self->{master} == $$; |
408
|
|
|
|
|
|
|
|
409
|
4
|
50
|
|
|
|
89
|
if (-r $self->{core}) { |
410
|
0
|
0
|
|
|
|
0
|
warn "Tarantool was coredumped\n" if -r $self->{core}; |
411
|
0
|
|
|
|
|
0
|
system "echo bt|gdb $self->{box} $self->{core}"; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
|
414
|
4
|
|
|
|
|
22
|
$self->kill; |
415
|
4
|
50
|
33
|
|
|
1769
|
rmtree $self->{temp} if $self->{temp} and !$self->{dont_unlink_temp}; |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub temp_dir { |
420
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
421
|
0
|
|
|
|
|
0
|
return $self->{temp}; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub clean_xlogs { |
426
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
427
|
0
|
0
|
|
|
|
0
|
return unless $self->{temp}; |
428
|
0
|
|
|
|
|
0
|
my @xlogs = glob catfile $self->{temp}, '*.xlog'; |
429
|
0
|
|
|
|
|
0
|
unlink for @xlogs; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
{ |
433
|
|
|
|
|
|
|
my %busy_ports; |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub _find_free_port { |
436
|
|
|
|
|
|
|
|
437
|
13
|
|
|
13
|
|
23
|
while( 1 ) { |
438
|
13
|
|
|
|
|
40
|
my $port = 10000 + int rand 30000; |
439
|
13
|
50
|
|
|
|
33
|
next if exists $busy_ports{ $port }; |
440
|
13
|
50
|
|
|
|
110
|
next unless IO::Socket::INET->new( |
|
|
50
|
|
|
|
|
|
441
|
|
|
|
|
|
|
Listen => 5, |
442
|
|
|
|
|
|
|
LocalAddr => '127.0.0.1', |
443
|
|
|
|
|
|
|
LocalPort => $port, |
444
|
|
|
|
|
|
|
Proto => 'tcp', |
445
|
|
|
|
|
|
|
(($^O eq 'MSWin32') ? () : (ReuseAddr => 1)), |
446
|
|
|
|
|
|
|
); |
447
|
13
|
|
|
|
|
3004
|
return $busy_ports{ $port } = $port; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
Copyright (C) 2011 Dmitry E. Oboukhov |
455
|
|
|
|
|
|
|
Copyright (C) 2011 Roman V. Nikolaev |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
This program is free software, you can redistribute it and/or |
458
|
|
|
|
|
|
|
modify it under the terms of the Artistic License. |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=head1 VCS |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
The project is placed git repo on github: |
463
|
|
|
|
|
|
|
L. |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
=cut |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
1; |