package ForkBlock; use strict; use vars qw/$CHILD_PID @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION/; use Carp; use Exporter; @ISA=("Exporter"); @EXPORT=qw/Fork Parent Child Error/; @EXPORT_OK=("DumbFork"); %EXPORT_TAGS=('all' => [qw/Fork Parent Child Error DumbFork/]); $VERSION=0.02; sub Fork { phork(@_) or croak "unable to fork: $!"; exit(0); } sub DumbFork { phork(@_) or croak "unable to fork: $!"; } sub Parent(&;%) { return "parent", @_ } sub Child(&;%) { return "child", @_ } sub Error(&;%) { return "error", @_ } #private--implements the actual forking sub phork { my %params=%{shift()}; my $parent=$params{"parent"}; my $child =$params{"child"} ; my $error =$params{"error"} ; local $!; FORK_IT: { if($CHILD_PID=fork()) { #i'm the parent &$parent; } elsif(defined($CHILD_PID)) { #i'm the child &$child; } else { #something went wrong if($! =~ /No more process/) { #recoverable, so wait a second and try again sleep 1; redo FORK_IT; } elsif(defined($error)) { #something went wrong, but an Error block was defined &$error; } else { #something went wrong, and the user forgot an Error block return 0; } } } return 1; } 1;