/usr/local/CPAN/PITA/PITA/Guest/Driver/Image/Test.pm

• package PITA::Guest::Driver::Image::Test
  • support_server_new
• EOF

package PITA::Guest::Driver::Image::Test;

use 5.008;
use strict;
use File::Spec                 ();
use Probe::Perl                ();
use PITA::Image                ();
use PITA::Guest::Driver::Image ();

our $VERSION = '0.50';
our @ISA     = 'PITA::Guest::Driver::Image';

# The location of the support server
my $image_bin = File::Spec->rel2abs(
	File::Spec->catfile( 't', 'bin', 'pita-imagetest' )
);
unless ( -f $image_bin ) {
	Carp::croak("Failed to find the pita-imagetest script");
}

# To allow for testing, whenever we return a support server we
# need to keep a reference to it.
use vars qw{$LAST_SUPPORT_SERVER};
BEGIN {
	$LAST_SUPPORT_SERVER = undef;
}

sub support_server_new {
	my $self   = shift;
	my $server = PITA::Guest::Server::Process->new(
		Program => [
			Probe::Perl->find_perl_interpreter,
			$image_bin,
			'--injector',
			$self->injector_dir,
		],
		Hostname    => $self->support_server_addr,
		Port        => $self->support_server_port,
		Mirrors     => { },
		# http_result => $self->support_server_results,
		# http_startup_timeout  => 30,
		# http_activity_timeout => 60,
		# http_shutdown_timeout => 30,
	);

	# Save the reference to the support server
	$LAST_SUPPORT_SERVER = $server;

	return $server;
}

1;