lib/PublicInbox/ProcessPipe.pm

   1 # Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # a tied handle for auto reaping of children tied to a pipe, see perltie(1)
   5 package PublicInbox::ProcessPipe;
   6 use strict;
   7 use v5.10.1;
   8 use PublicInbox::DS qw(dwaitpid);
   9
  10 sub TIEHANDLE {
  11         my ($class, $pid, $fh, $cb, $arg) = @_;
  12         bless { pid => $pid, fh => $fh, cb => $cb, arg => $arg }, $class;
  13 }
  14
  15 sub READ { read($_[0]->{fh}, $_[1], $_[2], $_[3] || 0) }
  16
  17 sub READLINE { readline($_[0]->{fh}) }
  18
  19 sub WRITE {
  20         use bytes qw(length);
  21         syswrite($_[0]->{fh}, $_[1], $_[2] // length($_[1]), $_[3] // 0);
  22 }
  23
  24 sub PRINT {
  25         my $self = shift;
  26         print { $self->{fh} } @_;
  27 }
  28
  29 sub adjust_ret { # dwaitpid callback
  30         my ($retref, $pid) = @_;
  31         $$retref = '' if $?
  32 }
  33
  34 sub CLOSE {
  35         my $fh = delete($_[0]->{fh});
  36         my $ret = defined $fh ? close($fh) : '';
  37         my ($pid, $cb, $arg) = delete @{$_[0]}{qw(pid cb arg)};
  38         if (defined $pid) {
  39                 unless ($cb) {
  40                         $cb = \&adjust_ret;
  41                         $arg = \$ret;
  42                 }
  43                 dwaitpid $pid, $cb, $arg;
  44         }
  45         $ret;
  46 }
  47
  48 sub FILENO { fileno($_[0]->{fh}) }
  49
  50 sub DESTROY {
  51         CLOSE(@_);
  52         undef;
  53 }
  54
  55 sub pid { $_[0]->{pid} }
  56
  57 1;