use strict; use warnings; use IO::Select qw( ); use IPC::Open3 qw( open3 ); use Symbol qw( gensym ); sub launch { my ($id) = @_; open(local *TO_CHILD, '<', '/dev/null') or die $!; *TO_CHILD if 0; my $pid = open3( '<&TO_CHILD', my $from_child = gensym(), '>&STDERR', perl => ( -e => 'use Time::HiRes qw( sleep ); $|=1; for (1..rand(10)+5) { sleep(0.100 + rand(100)/1000); print "a" }' ), ); return { id => $id, pid => $pid, pipe => $from_child, buf => '' }; } my %children = map { $_->{pipe} => $_ } map launch($_), 1..2; my $sel = IO::Select->new( map $_->{pipe}, values %children ); while ($sel->count) { for my $fh ($sel->can_read(0.050)) { my $child = $children{$fh}; our $buf; local *buf = \( $child->{buf} ); my $rv = sysread($fh, $buf, 64*1024, length($buf)); die $! if !defined($rv); if (!$rv) { delete $children{$fh}; $sel->remove($fh); waitpid($child->{pid}, 0); printf("%s: Exited with %08X after receiving %s\n", $child->{id}, $?, $buf); next; } printf("%s: Received some data\n", $child->{id}); } }