about summary refs log tree commit homepage
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/PublicInbox/MboxReader.pm3
-rw-r--r--lib/PublicInbox/ProcessPipe.pm45
-rw-r--r--lib/PublicInbox/Spawn.pm10
3 files changed, 33 insertions, 25 deletions
diff --git a/lib/PublicInbox/MboxReader.pm b/lib/PublicInbox/MboxReader.pm
index 1894756d..59ce4fb6 100644
--- a/lib/PublicInbox/MboxReader.pm
+++ b/lib/PublicInbox/MboxReader.pm
@@ -5,7 +5,6 @@
 package PublicInbox::MboxReader;
 use strict;
 use v5.10.1;
-use PublicInbox::DS (); # localize $in_loop for error detection :<
 use Data::Dumper;
 $Data::Dumper::Useqq = 1; # should've been the default, for bad data
 
@@ -14,7 +13,6 @@ my $from_strict =
 
 sub _mbox_from {
         my ($mbfh, $from_re, $eml_cb, @arg) = @_;
-        local $PublicInbox::DS::in_loop; # disable dwaitpid
         my $buf = '';
         my @raw;
         while (defined(my $r = read($mbfh, $buf, 65536, length($buf)))) {
@@ -75,7 +73,6 @@ sub _extract_hdr {
 
 sub _mbox_cl ($$$;@) {
         my ($mbfh, $uxs_from, $eml_cb, @arg) = @_;
-        local $PublicInbox::DS::in_loop; # disable dwaitpid
         my $buf = '';
         while (defined(my $r = read($mbfh, $buf, 65536, length($buf)))) {
                 if ($r == 0) { # detect "curl --fail"
diff --git a/lib/PublicInbox/ProcessPipe.pm b/lib/PublicInbox/ProcessPipe.pm
index 336d5ac4..400a22f3 100644
--- a/lib/PublicInbox/ProcessPipe.pm
+++ b/lib/PublicInbox/ProcessPipe.pm
@@ -6,10 +6,12 @@ package PublicInbox::ProcessPipe;
 use strict;
 use v5.10.1;
 use PublicInbox::DS qw(dwaitpid);
+use Carp qw(carp);
 
 sub TIEHANDLE {
         my ($class, $pid, $fh, $cb, $arg) = @_;
-        bless { pid => $pid, fh => $fh, cb => $cb, arg => $arg }, $class;
+        bless { pid => $pid, fh => $fh, ppid => $$, cb => $cb, arg => $arg },
+                $class;
 }
 
 sub READ { read($_[0]->{fh}, $_[1], $_[2], $_[3] || 0) }
@@ -26,32 +28,41 @@ sub PRINT {
         print { $self->{fh} } @_;
 }
 
-sub adjust_ret { # dwaitpid callback
-        my ($retref, $pid) = @_;
-        $$retref = '' if $?
-}
+sub FILENO { fileno($_[0]->{fh}) }
 
-sub CLOSE {
-        my $fh = delete($_[0]->{fh});
-        my $ret = defined $fh ? close($fh) : '';
-        my ($pid, $cb, $arg) = delete @{$_[0]}{qw(pid cb arg)};
-        if (defined $pid) {
-                unless ($cb) {
-                        $cb = \&adjust_ret;
-                        $arg = \$ret;
+sub _close ($;$) {
+        my ($self, $wait) = @_;
+        my $fh = delete $self->{fh};
+        my $ret = defined($fh) ? close($fh) : '';
+        my ($pid, $cb, $arg) = delete @$self{qw(pid cb arg)};
+        return $ret unless defined($pid) && $self->{ppid} == $$;
+        if ($wait) { # caller cares about the exit status:
+                my $wp = waitpid($pid, 0);
+                if ($wp == $pid) {
+                        $ret = '' if $?;
+                        if ($cb) {
+                                eval { $cb->($arg, $pid) };
+                                carp "E: cb(arg, $pid): $@" if $@;
+                        }
+                } else {
+                        carp "waitpid($pid, 0) = $wp, \$!=$!, \$?=$?";
                 }
+        } else { # caller just undef-ed it, let event loop deal with it
                 dwaitpid $pid, $cb, $arg;
         }
         $ret;
 }
 
-sub FILENO { fileno($_[0]->{fh}) }
+# if caller uses close(), assume they want to check $? immediately so
+# we'll waitpid() synchronously.  n.b. wantarray doesn't seem to
+# propagate `undef' down to tied methods, otherwise I'd rely on that.
+sub CLOSE { _close($_[0], 1) }
 
+# if relying on DESTROY, assume the caller doesn't care about $? and
+# we can let the event loop call waitpid() whenever it gets SIGCHLD
 sub DESTROY {
-        CLOSE(@_);
+        _close($_[0]);
         undef;
 }
 
-sub pid { $_[0]->{pid} }
-
 1;
diff --git a/lib/PublicInbox/Spawn.pm b/lib/PublicInbox/Spawn.pm
index 1ee40503..762a0549 100644
--- a/lib/PublicInbox/Spawn.pm
+++ b/lib/PublicInbox/Spawn.pm
@@ -295,14 +295,14 @@ sub spawn ($;$$) {
 }
 
 sub popen_rd {
-        my ($cmd, $env, $opts) = @_;
+        my ($cmd, $env, $opt) = @_;
         pipe(my ($r, $w)) or die "pipe: $!\n";
-        $opts ||= {};
-        $opts->{1} = fileno($w);
-        my $pid = spawn($cmd, $env, $opts);
+        $opt ||= {};
+        $opt->{1} = fileno($w);
+        my $pid = spawn($cmd, $env, $opt);
         return ($r, $pid) if wantarray;
         my $ret = gensym;
-        tie *$ret, 'PublicInbox::ProcessPipe', $pid, $r;
+        tie *$ret, 'PublicInbox::ProcessPipe', $pid, $r, @$opt{qw(cb arg)};
         $ret;
 }