File Coverage

blib/lib/Process/Launcher.pm

Criterion	Covered	Total	%
statement	32	86	37.2
branch	3	28	10.7
condition	0	2	0.0
subroutine	10	15	66.6
pod	3	6	50.0
total	48	137	35.0

package Process::Launcher;

use 5.00503;
use strict;
use Exporter              ();
use Params::Util          ();
use Process               ();
use Process::Serializable ();

use vars qw{$VERSION @ISA @EXPORT};
BEGIN {
	$VERSION = '0.30';
	@ISA     = qw{Exporter};
	@EXPORT  = qw{run run3 serialized};

	# Preload the heavyish Process::Storable module
	# (if prefork is available)
	eval "use prefork 'Process::Storable';";
}





#####################################################################
# Interface Functions

sub run() {
	my $class  = load(shift @ARGV);

	# Create the object
	my $object = $class->new( @ARGV );
	unless ( $object ) {
		fail("$class->new returned false");
	}

	# Run it
	execute($object);

	exit(0);
}

sub run3() {
	my $class = load(shift @ARGV);

	# Load the params from STDIN
	my @params = ();
	SCOPE: {
		# Implementation recycled from Config::Tiny
		local $/;
		my $input = ;
		foreach ( split /(?:\015{1,2}\012|\015|\012)/, $input ) {
			if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
				push @params, $1, $2;
				next;
			}
			fail("Input did not match the correct format");
		}
	}

	# Create the process
	my $object = $class->new( @params );
	unless ( $object ) {
		fail("$class->new returned false");
	}

	# Run it
	execute($object);

	exit(0);
}

sub serialized() {
	my $class = load(shift @ARGV);
	unless ( $class->isa('Process::Serializable') ) {
		fail("$class is not a Process::Serializable subclass");
	}

	# Deserialize the object
	my $input  = shift @ARGV;
	my $object = $class->deserialize( $input or \*STDIN );
	unless ( $object ) {
		fail("Failed to deserialize STDIN to a $class");
	}

	# Run it
	execute($object);

	# Return the object after execution
	$object->serialize(\*STDOUT);

	exit(0);
}





#####################################################################
# Support Functions

sub execute($) {
	my $object = shift;
	my $class  = ref($object);
	if ( $object->isa('Process::Backgroundable') ) {
		close STDIN;
		my $pid = fork();
		exit(0) if $pid;
	}

	# Prepare the Process
	my $rv = eval { $object->prepare };
	fail("$class->prepare died: $@")       if $@;
	fail("$class->prepare returned false") unless $rv;

	# Run the process
	$rv = eval { $object->run };
	fail("$class->run died: $@")       if $@;
	fail("$class->run returned false") unless $rv;

	print "OK\n";
}

sub load($) {
	my $class = shift;
	unless ( Params::Util::_CLASS($class) ) {
		fail("Did not provide a valid class as first argument");
	}
	eval "require $class";
	fail("Error loading $class: $@") if $@;
	unless ( $class->isa('Process') ) {
		fail("$class is not a Process class");
	}
	$class;
}

sub fail($) {
	my $message = shift;
	$message =~ s/\n$//;
	print "FAIL - $message\n";
	exit(0);
}

1;

__END__