use strict;
use warnings;
use vars qw($PERL $PATH $ITEM_SERVER_PID $ECHO_SERVER_PID);

use Config;
use Cwd;

# hack devised by Gisle Aas:
$PERL = $Config{'perlpath'};
$PERL = $^X if ($^O eq 'VMS' or -x $^X && $^X =~ m|^([a-z]:)?/|i);

$PATH = (cwd() =~ m|/t$|)
		? 'testserver.pl'
		: './t/testserver.pl';

$ITEM_SERVER_PID = undef;
$ECHO_SERVER_PID = undef;





sub launch_item_server
{
	my $pid = open(ITEM_SERVER, "$PERL $PATH |")
		or die "Couldn't launch the item server: $!.\n";

	my $line = <ITEM_SERVER>;

	(my $port) = $line =~ /(\d+)/;

	die "Server isn't listening."
		unless ($line =~ /^# Listening on port $port\.\.\./);

	$ITEM_SERVER_PID = $pid;

	return $port;
}



sub launch_echo_server
{
	my $pid = open(ECHO_SERVER, "$PERL $PATH -e |")
		or die "Couldn't launch the test server: $!.\n";

	my $line = <ECHO_SERVER>;

	(my $port) = $line =~ /(\d+)/;

	die "Server isn't listening."
		unless ($line =~ /^# Listening on port $port\.\.\./);

	$ECHO_SERVER_PID = $pid;

	return $port;
}



sub kill_servers
{
	return 1 unless ($ITEM_SERVER_PID || $ECHO_SERVER_PID);

	if ($ITEM_SERVER_PID)
	{
		kill(INT => $ITEM_SERVER_PID);
		waitpid($ITEM_SERVER_PID, 0);

		$ITEM_SERVER_PID = undef;

		close ITEM_SERVER;
	}

	if ($ECHO_SERVER_PID)
	{
		kill(INT => $ECHO_SERVER_PID);
		waitpid($ECHO_SERVER_PID, 0);

		$ECHO_SERVER_PID = undef;

		close ECHO_SERVER;
	}

	return 1;
}





BEGIN {
	$SIG{'__DIE__'} = sub { kill_servers() };
}

1;


syntax highlighted by Code2HTML, v. 0.9.1