forked from hachi/perl-Gearman-Client-Async
-
Notifications
You must be signed in to change notification settings - Fork 0
/
testlib.pl
81 lines (67 loc) · 1.96 KB
/
testlib.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
#!/usr/bin/perl
use strict;
use warnings;
our $Bin;
use FindBin qw( $Bin );
# for working out of svn:
use lib "$Bin/../../Gearman/lib";
$ENV{PERL5LIB} .= ":$Bin/../../Gearman/lib";
# for disttest, which is another layer down. :(
use lib "$Bin/../../../Gearman/lib";
$ENV{PERL5LIB} .= ":$Bin/../../../Gearman/lib";
use Gearman::Client::Async;
use POSIX qw( :sys_wait_h );
use List::Util qw(first);;
use IO::Socket::INET;
use File::Basename 'dirname';
Danga::Socket->SetLoopTimeout(100);
our %Children;
END { kill_children() }
sub start_server {
my($port) = @_;
my @loc = ("$Bin/../../../../server/gearmand", # using svn
"$Bin/../../../../../server/gearmand", # using svn, with disttest
dirname($^X) . '/gearmand', # local installs (e.g. perlbrew)
'/usr/bin/gearmand', # where some distros might put it
'/usr/sbin/gearmand', # where other distros might put it
);
my $server = first { -e $_ } @loc
or return 0;
my $pid = start_child([ $server, '-p', $port ]);
$Children{$pid} = 'S';
wait_for_port($port);
return $pid;
}
sub start_worker {
my($port, $num) = @_;
my $worker = "$Bin/worker.pl";
my $servers = join ',',
map '127.0.0.1:' . (PORT + $_),
0..$num-1;
my $pid = start_child([ $worker, '-s', $servers ]);
$Children{$pid} = 'W';
return $pid;
}
sub start_child {
my($cmd) = @_;
my $pid = fork();
die $! unless defined $pid;
unless ($pid) {
exec $^X, '-Iblib/lib', '-Ilib', @$cmd or die $!;
}
$pid;
}
sub kill_children {
kill INT => keys %Children;
}
sub wait_for_port {
my($port) = @_;
my $start = time;
while (1) {
my $sock = IO::Socket::INET->new(PeerAddr => "127.0.0.1:$port");
return 1 if $sock;
select undef, undef, undef, 0.25;
die "Timeout waiting for port $port to startup" if time > $start + 5;
}
}
1;