+use IPC::MorseSignals qw/msend mrecv mreset/;
+
+my $lives = 100;
+
+sub spawn {
+ --$lives;
+ die 'forked too many times' if $lives < 0;
+ pipe my $rdr, my $wtr or die "pipe() failed: $!";
+ my $pid = fork;
+ if (!defined $pid) {
+ die "fork() failed: $!";
+ } elsif ($pid == 0) {
+ local %SIG;
+ close $rdr or die "close() failed: $!";
+ select $wtr;
+ $| = 1;
+ my $rcv = mrecv %SIG, cb => sub { print $wtr $_[1], "\n" };
+ my $ppid = getppid;
+ $SIG{ALRM} = sub { alarm 1; kill SIGHUP => $ppid };
+ alarm 1;
+ $SIG{HUP} = sub { alarm 0; mreset $rcv };
+ 1 while 1;
+ exit EXIT_FAILURE;
+ }
+ my $ready = 0;
+ local $SIG{HUP} = sub { $ready = 1 };
+ sleep 1 until $ready;
+ close $wtr or die "close() failed: $!";
+ my $oldfh = select $rdr;
+ $| = 1;
+ select $oldfh;
+ return ($pid, $rdr);
+}
+
+sub slaughter {
+ my ($pid, $rdr) = @_;
+ if (defined $rdr) {
+ close $rdr or die "close() failed: $!";
+ }
+ if (defined $pid) {
+ kill SIGINT => $pid;
+ kill SIGTERM => $pid;
+ kill SIGKILL => $pid;
+ waitpid $pid, 0;
+ }
+}