about summary refs log tree commit homepage
path: root/lib/PublicInbox/ProcessIO.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/PublicInbox/ProcessIO.pm')
-rw-r--r--lib/PublicInbox/ProcessIO.pm83
1 files changed, 83 insertions, 0 deletions
diff --git a/lib/PublicInbox/ProcessIO.pm b/lib/PublicInbox/ProcessIO.pm
new file mode 100644
index 00000000..eeb66139
--- /dev/null
+++ b/lib/PublicInbox/ProcessIO.pm
@@ -0,0 +1,83 @@
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+
+# a tied handle for auto reaping of children tied to a pipe or socket,
+# see perltie(1) for details.
+package PublicInbox::ProcessIO;
+use v5.12;
+use PublicInbox::DS qw(awaitpid);
+use Symbol qw(gensym);
+
+sub maybe_new {
+        my ($cls, $pid, $fh, $opt) = @_;
+        return ($fh, $pid) if wantarray;
+        my $s = gensym;
+        tie *$s, $cls, $pid, $fh, @{$opt->{cb_arg} // []};
+        $s;
+}
+
+sub waitcb { # awaitpid callback
+        my ($pid, $err_ref, $cb, @args) = @_;
+        $$err_ref = $?; # sets >{pp_chld_err} for _close
+        $cb->($pid, @args) if $cb;
+}
+
+sub TIEHANDLE {
+        my ($cls, $pid, $fh, @cb_arg) = @_;
+        my $self = bless { pid => $pid, fh => $fh, ppid => $$ }, $cls;
+        # we share $err (and not $self) with awaitpid to avoid a ref cycle
+        $self->{pp_chld_err} = \(my $err);
+        awaitpid($pid, \&waitcb, \$err, @cb_arg);
+        $self;
+}
+
+# for IO::Uncompress::Gunzip
+sub BINMODE {
+        my $self = shift;
+        binmode($self->{fh}, @_);
+}
+
+sub READ { read($_[0]->{fh}, $_[1], $_[2], $_[3] || 0) }
+
+sub READLINE { readline($_[0]->{fh}) }
+
+sub WRITE {
+        use bytes qw(length);
+        syswrite($_[0]->{fh}, $_[1], $_[2] // length($_[1]), $_[3] // 0);
+}
+
+sub PRINT {
+        my $self = shift;
+        print { $self->{fh} } @_;
+}
+
+sub FILENO { fileno($_[0]->{fh}) }
+
+sub _close ($;$) {
+        my ($self, $wait) = @_;
+        my ($fh, $pid) = delete(@$self{qw(fh pid)});
+        my $ret = (defined($fh) && $wait) ? close($fh) : ($fh = '');
+        return $ret unless defined($pid) && $self->{ppid} == $$;
+        if ($wait) { # caller cares about the exit status:
+                # synchronous wait via defined(wantarray) on awaitpid:
+                defined(${$self->{pp_chld_err}}) or $wait = awaitpid($pid);
+                ($? = ${$self->{pp_chld_err}}) and $ret = '';
+        } else {
+                awaitpid($pid); # depends on $in_loop or not
+        }
+        $ret;
+}
+
+# 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($_[0]);
+        undef;
+}
+
+1;