Changeset 20187 for lang/perl

Timestamp:

09/29/08 13:09:04 (5 years ago)

Author:

daisuke

Message:

add a on_child_reap callback

Location:

lang/perl/Parallel-Prefork/trunk

Files:

• lib/Parallel/Prefork.pm (modified) (4 diffs)
• t/01-base.t (modified) (2 diffs)

lang/perl/Parallel-Prefork/trunk/lib/Parallel/Prefork.pm

@@ -8 +8 @@
 use Proc::Wait3;
 
-__PACKAGE__->mk_accessors(qw/max_workers err_respawn_interval trap_signals signal_received manager_pid/);
+__PACKAGE__->mk_accessors(qw/max_workers err_respawn_interval trap_signals signal_received manager_pid on_child_reap/);
 
 our $VERSION = '0.03';
@@ -62 +62 @@
         }
         if (my ($exit_pid, $status) = wait3(! $pid)) {
+            $self->_run_child_reap_cb( $exit_pid, $status );
+
             if (delete($self->{worker_pids}{$exit_pid}) == $self->{generation}
-                    && $status != 0) {
+                && $status != 0) {
                 sleep $self->err_respawn_interval;
             }
@@ -89 +91 @@
 }
 
+sub _run_child_reap_cb {
+    my ($self, $exit_pid, $status) = @_;
+    my $cb = $self->on_child_reap;
+    if ($cb) {
+        eval {
+            $cb->($self, $exit_pid, $status);
+        };
+        # XXX - hmph, what to do here?
+    }
+}
+
 sub wait_all_children {
     my $self = shift;
     while (%{$self->{worker_pids}}) {
         if (my $pid = wait) {
-            delete $self->{worker_pids}{$pid};
+            if (delete $self->{worker_pids}{$pid}) {
+                $self->_run_child_reap_cb($pid, $?);
+            }
         }
     }
@@ -152 +167 @@
 hashref of signals to be trapped.  Manager process will trap the signals listed in the keys of the hash, and send the signal specified in the associated value (if any) to all worker processes.
 
+=head3 on_child_reap
+
+Coderef that is called when a child is reaped. Receives the instance to
+the current Paralle::Prefork, the child's pid, and its exit status.
+
 =head2 start
 

lang/perl/Parallel-Prefork/trunk/t/01-base.t

@@ -6 +6 @@
 use Fcntl qw/:flock/;
 use File::Temp qw/tempfile/;
-use Test::More tests => 4;
+use Test::More tests => 5;
 
 use_ok('Parallel::Prefork');
 
+my $reaped = 0;
 my $pm;
 eval {
     $pm = Parallel::Prefork->new({
-        max_workers => 10,
-        fork_delay  => 0,
+        max_workers   => 10,
+        fork_delay    => 0,
+        on_child_reap => sub {
+            $reaped++;
+        }
     });
 };
@@ -61 +65 @@
 close $fh;
 is($c, $pm->max_workers * 2);
+is($reaped, $pm->max_workers, "properly called on_child_reap callback");
 
 unlink $filename;