Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:
sub run_parallel { my $job_count = shift; unless (0 < $job_count) { confess("run_parallel called without a positive parallel job count +!"); } my @to_start = @_; my %running; my %errors; my $is_running = 0; while (@to_start or %running) { if (@to_start and ($is_running < $job_count)) { # Launch a job my $job = shift @to_start; unless (ref($job)) { $job = [$job]; } open (NULL, $null_file) or confess("Cannot read from $null_file: + $!"); my $proc_id = open3("<&NULL", \*CMD_OUT, \*CMD_ERR, @$job); $running{$proc_id} = $job; ++$is_running; } else { # collect a job my $proc_id = wait(); if (! exists $running{$proc_id}) { confess("Reaped unknown process $proc_id!"); } elsif ($?) { # Oops my $job = $running{$proc_id}; my ($cmd, @args) = @$job; my $err = "Running '$cmd' gave return code '$?'"; if (@args) { $err .= join "\n\t", "\nAdditional args:", @args; } $errors{$proc_id} = $err; } delete $running{$proc_id}; --$is_running; } } return %errors; $mw_status_window->fileevent(\*CMD_OUT, 'readable', \&read_out); $mw_status_window->fileevent(\*CMD_ERR, 'readable', \&read_err); } sub read_out { my $line = <CMD_OUT>; unless ($line) { close(CMD_OUT); } else { print "green", "$line\n"; } } sub read_out { my $line = <CMD_ERR>; unless ($line) { close(CMD_ERR); } else { print "red", "$line\n"; } }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Printing STDERR from run_parallel...
by rjray (Chaplain) on Mar 23, 2002 at 05:18 UTC | |
by Anonymous Monk on Mar 23, 2002 at 08:17 UTC |