From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

#!/usr/bin/env perl -wls
use Socket;
use POSIX ':sys_wait_h';
BEGIN { $J ||= 1; }
sub spawn(&) {
my ($proc) = @_;
my %child;
for ( 1 .. $J ) {
socketpair( my $CHILD, my $PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC )
or die "$!";
map { $_->autoflush(1) } ( $CHILD, $PARENT );
unless ( my $pid = fork ) {
die "cannot fork: $!" unless defined $pid;
close $CHILD;
$proc->($PARENT);
close $PARENT;
exit;
}
else {
close $PARENT;
$child{$pid} = $CHILD;
}
}
return \%child;
}
my $children = spawn {
my ($PARENT) = @_;
while (<$PARENT>) {
chomp;
print $PARENT "Child Pid $$ got $_";
}
};
sub reaper {
my $pid;
while ( ( $pid = waitpid( -1, WNOHANG ) ) > 0 ) {
delete $children->{$pid};
}
$SIG{CHLD} = \&reaper;
}
$SIG{CHLD} = \&reaper;
for my $pid ( keys %$children ) {
my $CHILD = $children->{$pid};
print $CHILD "Parent Pid $$ is sending this";
chomp( $line = <$CHILD> );
print "Parent Pid $$ just read this: `$line'";
close $CHILD;
}