File Coverage

blib/lib/Proc/Fork.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	33	50	66.0
condition	6	9	66.6
subroutine	11	11	100.0
pod	5	5	100.0
total	106	126	84.1

use 5.006; use strict; use warnings;

package Proc::Fork;

our $VERSION = '0.806';

use Exporter::Tidy (
	default => [ ':all' ],
	wrapper => [ 'run_fork' ],
	blocks  => [ qw( parent child error retry ) ],
);

sub _croak { require Carp; goto &Carp::croak }

my $do_clear = 1;
my ( $parent, $child, $error, $retry );

sub run_fork(&) {
	my $setup = shift;

	my @r = $setup->();
	_croak "Garbage in Proc::Fork setup (semicolon after last block clause?)" if @r;
	$do_clear = 1;

	my $pid;
	my $i;

	{
		$pid = fork;
		last if defined $pid;
		redo if $retry and $retry->( ++$i );
		die "Cannot fork: $!\n" if not $error;
		$error->();
		return;
	}

	$_->( $pid || () ) for ( $pid ? $parent : $child ) || ();

	return;
}

for my $block ( qw( parent child error retry ) ) {
	my $code = q{sub _BLOCK_ (&;@) {
		$parent = $child = $error = $retry = $do_clear = undef if $do_clear;
		_croak "Duplicate _BLOCK_ clause in Proc::Fork setup" if $_BLOCK_;
		$_BLOCK_ = shift if 'CODE' eq ref $_[0];
		_croak "Garbage in Proc::Fork setup (after _BLOCK_ clause)" if @_;
		run_fork {} if not defined wantarray; # backcompat
		();
	}};
	$code =~ s/_BLOCK_/$block/g;
	eval $code;
}

1;

__END__