#!/usr/local/bin/perl5

use POSIX qw(:sys_wait_h);
use IO::Handle;

my %scythe;                     # a scythe for the REAPER (see FAQ);
$SIG{CHLD} = \&REAPER;          # set handling of dead child processes.
STDOUT->autoflush;              # make sure output is flushed before forking

# setup an interupt handler (^C)
#  kills every pid used as a key in %scythe
####################
$SIG{INT} = sub {
    print "\nCleaning: ";
    print join(", ", keys(%scythe));
    print "\n";
    kill('INT', keys %scythe);
    print "done with: ";
    print join(", ", keys(%scythe));
    die "\n";
};


#### MAIN ####

#### END MAIN, begin defs ####

sub phork {
  # we will call fork and return a pid.  The child will exec with all args
  # and suppress the child's output;
  my $pid;

  if ($pid = fork) {                    # fork the process;
    #parent
    return $pid;
  }else
  {
    #child
    die "CANNOT FORK!!\n" unless defined $pid;
    close(STDOUT);                      # suppressing output
    close(STDERR);                      # suppressing output
    {exec(@_);};                        # calls exec with current @_
    exit(1);                            # exec may maybe fail... maybe.
  }
}


sub bait {
#  This functions is a dummy to be used to be added to %scythe for a $pid
#  This way when the interupt is called, the process with the $pid will
#  be cleaned up (killed) so it doesn't keep running after its parent's
#  death.  If you'd rather it did, (for some twisted reason) just don't assign
#  anything in %scythe for the key of it's $pid.  [I don't recommend it
#  though]
        return "Come get some!";
}

sub REAPER { 
# we reap child processes, and post process it.
# note: this sub relies on a global %scythe
#     If a $scythe{$pid} is defined, it will assume that its a 
#     reference to a function that takes $pid and $exit_value as args
#     and presumably does something useful with that.  Then it deletes the 
#     $scythe{$pid} hash entry.   is it not nifty?

  # local vars
  my $pid;
  my $exit_value;

  $pid = waitpid(-1, &WNOHANG);

  if($pid == -1) {
    # no child waiting
  }
  elsif (WIFEXITED($?)) 
  {
    # the process exited, get exit value.
    my $slot;
    my $state;

    $exit_value = $? >> 8;
    if (exists($scythe{$pid})) {
      $scythe{$pid}->( $pid, $exit_value );
      delete($scythe{$pid});
    } else {
      # we're reaping something we didn't sow or didn't care about;
      return;
    }
  }
  else
  {
    # false alarm on $pid
  }
  $SIG{CHLD} = \&REAPER;                #reset signal handling.
} #end sub REAPER