Update: See IPC-Run or Proc-SafeExec for much more robust ways to deal with this issue.
This was inspired by FileHandle->close() is not closing everything, where children in a piped open apparently won't terminate. This snippet opens a filehandle to a pipeline of system commands, and sends pids of child processes to the parent process (for possible later termination assuming the children don't fork other children which won't terminate, etc. Or whatever purpose you can think up...). This was mainly a learning exercise, so any pointers to more developed CPAN modules are welcome (and at the time of this writing, CPAN is down). This method of forking has the additional benefit of calling exec with a list of arguments, bypassing the shell, so there's no need to quote args or avoid metacharacters in the arguments.
It may take a bit of tweaking to make this more robust, but I think its a decent starting point. This seems to work, but I'm open to comments.
Update: one possible improvement might be to use flock so that only one child at a time can write the pid info to the parent (not sure if you can flock a pipe handle, or if it would do any good).
Update: Combined 2 subroutines into one.
Update: I've found you can't depend on the order in which the pids are read, so I've added a counter to sort by.
#!/usr/bin/perl
sub pipeline {
pipe my ($read, $write);
my $pid = open(my $fh, "-|");
die "Couldn't fork: $!" unless defined $pid;
if ($pid) {
close $write;
chomp(my @pids = map { $_->[1] } sort { $b->[0] <=> $a->[0] } map
+{ [ split /_/ ] } <$read>);
close $read;
return $fh, @pids;
}
close $read;
exit unless @_;
my $cnt;
while (my $command = pop) {
$cnt++;
my $pid = @_ ? open(STDIN, "-|") : -1;
die "Couldn't fork: $!" unless defined $pid;
next unless $pid;
print $write "${cnt}_$$\n";
close $write;
exec @$command;
die "Couldn't exec @$command";
}
}
# Silly example, but you get the idea
# essentially the same as:
# open($fh, "ls -1 | sed -e s/t/a/g |")
my ($fh, @pids) = pipeline(
[qw(ls -1)],
[qw(sed -e s/t/a/g)],
);
while (<$fh>) {
print "$.:$_";
}
close $fh;
print "Pids: @pids\n";
