This is gonna require some fork games and some fun signal handling.
I should publish the standard warnings that perl's signal
handling leaves a lot to be desired and do not blame me
if this causes all your hair to fall out and sets your
workstation on fire :)
Basically, what I am going to do is to spawn the PIPE process
off as a child process. The parent process will watch for
two signals: SIGINT will cause the parent to kill the child
off and SIGHUP will cause the parent to kill the child and
then itself. To avoid perl's signal problems, I am keeping
the handlers very, very simple - they each set a variable
and let the main loop handle it. There are still race conditions
in the code, which may or may not be able to be fixed.
Also, not to put too much of a point on it, I am not
using a SIGCHLD handler. I use waitpid and reap the children
myself.
I am also gonna do this a bit of pseudo-code here - I am
currently too lazy to cut'n'paste :)
sub spawn {
my ( $interesting, $vars, $here ) = @_;
my $pid = 0;
# The parent process returns the spawned process's pid.
# The spawned process does the work
if ( $pid = fork ) {
return $pid;
}
else {
# do lots of interesting things
# Either exit or exec - just make sure the kid
# never returns.
exit 0;
}
}
my $stop_all = 0;
my $stop_kid = 0;
my $kid_pid = 0;
# Trying to minimize my risk here, I simply set a variable
# and let the later code handle it. It isn't perfect,
# but it works.
# SIGINT stops the kid. SIGHUP stops everything
$SIG{SIGHUP} = sub { $stop_all = 1; }
$SIG{INT} = sub { $stop_kid = 1; }
# This loops forever. You may not want that :) The 5 second sleep
# also keeps you from eating too many CPU cycles. Note it
# will also mean a maximum 5 second delay between sending the
# SIGINT or SIGHUP and anything happening. If that is not
# acceptable, use select(undef,undef,undef,0.5)
while( 1 ) {
sleep 5;
if ( $stop_all ) {
kill 9, $kid_pid if ( $kid_pid && $kid_pid != -1 );
exit;
}
# Race conditions ahead! Don't lean too heavily on the
# CTRL-C key
if ( $stop_kid ) {
kill 9, $kid_pid if ( $kid_pid > 0 );
$stop_kid = 0;
}
# I am a bad man and do not use POSIX. The 1 may
# change depending on the OS - this works for
# Solaris and FreeBSD
my $dpid = waitpid( -1, 1 );
$kid_pid = spawn() if ( $dpid == $kid_pid || $dpid = -1 );
}
This is untested, but there is also a lot of code to be
found on perlmonks dealing with forking and reaping child
processes. I have a very extensive example playing games
like this but do not have the source code immediately
available. I will check when I get home and make sure
this example is mostly correct.
Mik
mikfire |