The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package GearTestLib;
use strict;
use IO::Socket::INET;
use Exporter 'import';
use FindBin;
use Carp qw(croak);
use vars qw(@EXPORT);

@EXPORT = qw(sleep);

sub sleep {
    my $n = shift;
    select undef, undef, undef, $n;
}

sub free_port {
    my $port = shift;
    my $type = shift || "tcp";
    my $sock;
    while (!$sock) {
        $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1',
                                      LocalPort => $port,
                                      Proto     => $type,
                                      ReuseAddr => 1);
        return $port if $sock;
        $port = int(rand(20000)) + 30000;
    }
    return $port;
}

sub start_child {
    my($cmd) = @_;
    my $pid = fork();
    die $! unless defined $pid;
    unless ($pid) {
        exec 'perl', '-Iblib/lib', '-Ilib', @$cmd or die $!;
    }
    $pid;
}

package Test::GearServer;
use List::Util qw(first);

my $requested_port = 8999;

sub new {
    my $class = shift;
    my $port = GearTestLib::free_port(++$requested_port);

    my @loc = ("$FindBin::Bin/../../../../server/gearmand",  # using svn
               '/usr/bin/gearmand',            # where some distros might put it
               '/usr/sbin/gearmand',           # where other distros might put it
               );
    my $server = first { -e $_ } @loc;
    unless ($server) {
        warn "Can't find gearmand in any of: @loc\n";
        return 0;
    }

    my $ready = 0;
    local $SIG{USR1} = sub {
        $ready = 1;
    };

    my $pid = GearTestLib::start_child([ $server, '-p' => $port, '-n' => $$ ]);
    while (!$ready) {
        select undef, undef, undef, 0.10;
    }
    return bless {
        pid => $pid,
        port => $port,
    }, $class;
}

sub ipport {
    my $self = shift;
    return "127.0.0.1:$self->{port}";
}

sub DESTROY {
    my $self = shift;
    kill 9, $self->{pid} if $self->{pid};
}

1;