| Subject: | Let run_on_wait callback |
It would be nice if the run_on_wait callback could abort the operation,
for example by returning a false value.
Use cases would be having the a timeout on how long a single job would
wait or having Parallel::ForkManager respect a signal handler setting a
flag to abort the process:
my $abort = 0;
$SIG{HUP} = sub { $abort = 1 };
$pm->run_on_wait( sub { return ! $abort } );
while (not $abort) {
my $job = shift @queue;
$pm->start($job) and next;
... ... ...
$pm->finish;
}
The attached patch implements this by having $pm->start return '0 but
true' if the process was aborted. Beware that this changes the interface
in a not quite compatible way.
| Subject: | ForkManager.patch |
--- /usr/share/perl5/Parallel/ForkManager.pm 2006-06-15 03:28:44.000000000 +0200
+++ ForkManager.pm 2008-05-06 11:41:07.908057188 +0200
@@ -281,7 +281,8 @@
die "Cannot start another process while you are in the child process"
if $s->{in_child};
while ($s->{max_proc} && ( keys %{ $s->{processes} } ) >= $s->{max_proc}) {
- $s->on_wait;
+ $s->on_wait
+ or return "0 but true";
$s->wait_one_child(defined $s->{on_wait_period} ? &WNOHANG : undef);
};
$s->wait_children;
@@ -360,13 +361,15 @@
}
sub on_wait { my ($s)=@_;
+ my $result = 1;
if(ref($s->{on_wait}) eq 'CODE') {
- $s->{on_wait}->();
+ $result = $s->{on_wait}->();
if (defined $s->{on_wait_period}) {
local $SIG{CHLD} = sub { } if ! defined $SIG{CHLD};
select undef, undef, undef, $s->{on_wait_period}
};
};
+ return $result;
};
sub run_on_start { my ($s,$code)=@_;