package TestGearman;
use base qw(Exporter);
@EXPORT = qw(start_server wait_for_port start_worker respawn_children pid_is_dead PORT %Children $NUM_SERVERS);
use strict;
use List::Util qw(first);;
use IO::Socket::INET;
use POSIX qw( :sys_wait_h );
our $Bin;
use FindBin qw( $Bin );
# TODO: use a variation of t/lib/GearTestLib::free_port to find 3 free ports
use constant PORT => 9050;
our $NUM_SERVERS = 1;
our %Children;
END { kill_children() }
sub start_server {
my($port) = @_;
my @loc = ("$Bin/../../../../server/gearmand", # using svn
"$Bin/../../../../../server/gearmand", # using svn and 'disttest'
'/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 $ready = 0;
local $SIG{USR1} = sub {
$ready = 1;
};
my $pid = start_child([ $server, '-p' => $port, '-n' => $$ ]);
$Children{$pid} = 'S';
while (!$ready) {
select undef, undef, undef, 0.10;
}
return $pid;
}
sub start_worker {
my($port, $args) = @_;
my $num_servers;
unless (ref $args) {
$num_servers = $args;
$args = {};
}
$num_servers ||= $args->{num_servers} || 1;
my $worker = "$Bin/worker.pl";
my $servers = join ',',
map '127.0.0.1:' . (PORT + $_),
0..$num_servers-1;
my $ready = 0;
my $pid;
local $SIG{USR1} = sub {
$ready = 1;
};
$pid = start_child([ $worker, '-s' => $servers, '-n' => $$, ($args->{prefix} ? ('-p' => $args->{prefix}) : ()) ]);
$Children{$pid} = 'W';
while (!$ready) {
select undef, undef, undef, 0.10;
}
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;
}
}
sub pid_is_dead {
my($pid) = @_;
return if $pid == -1;
my $type = delete $Children{$pid};
if ($type eq 'W') {
## Right now we can only restart workers.
start_worker(PORT, $NUM_SERVERS);
}
}
sub respawn_children {
for my $pid (keys %Children) {
if (waitpid($pid, WNOHANG) > 0) {
pid_is_dead($pid);
}
}
}
1;
syntax highlighted by Code2HTML, v. 0.9.1