-my $lives = 5;
-
-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) {
- close $rdr or die "close() failed: $!";
- binmode $wtr, ':utf8';
- my $block = 0;
- my $s = mrecv local %SIG, cb => sub {
- if ($block) {
- $block = 0;
- } else {
- select $wtr; $| = 1;
- print $wtr $_[1], "\n";
- select $wtr; $| = 1;
- }
- };
- $SIG{HUP} = sub { mreset $s };
- $SIG{__WARN__} = sub { $block = 1 };
- 1 while 1;
- exit EXIT_FAILURE;
- }
- close $wtr or die "close() failed: $!";
- binmode $rdr, ':utf8';
- return ($pid, $rdr);
-}
-
-sub slaughter {
- my ($pid) = @_;
- kill SIGINT => $pid;
- kill SIGTERM => $pid;
- kill SIGKILL => $pid;
- waitpid $pid, 0;
-}
-
-my ($pid, $rdr) = spawn;