spawn: support synchronous run_qx

This is similar to `backtick` but supports all our existing spawn
functionality (chdir, env, rlimit, redirects, etc.).  It also
supports SCALAR ref redirects like run_script in our test suite
for std{in,out,err}.

We can probably use :utf8 by default for these redirects, even.

diff --git a/lib/PublicInbox/Git.pm b/lib/PublicInbox/Git.pm
index a460d15551fc31cdee2a43e8e12a41f233cc9f3c..476dcf30f016b1a84e4dedfec4a40b085e85d819 100644 (file)
--- a/lib/PublicInbox/Git.pm
+++ b/lib/PublicInbox/Git.pm
@@ -69,6 +69,7 @@ sub check_git_exe () {
                $GIT_VER = eval("v$1") // die "BUG: bad vstring: $1 ($v)";
                $EXE_ST = $st;
        }
+       $GIT_EXE;
 }
 
 sub git_version {
@@ -422,6 +423,11 @@ sub async_err ($$$$$) {
        $async_warn ? carp($msg) : $self->fail($msg);
 }
 
+sub cmd {
+       my $self = shift;
+       [ $GIT_EXE // check_git_exe(), "--git-dir=$self->{git_dir}", @_ ]
+}
+
 # $git->popen(qw(show f00)); # or
 # $git->popen(qw(show f00), { GIT_CONFIG => ... }, { 2 => ... });
 sub popen {

diff --git a/lib/PublicInbox/SearchIdx.pm b/lib/PublicInbox/SearchIdx.pm
index 8a571cfbf4f0939fca5a65422577f379eb357ca0..3c64c715ad7d0e72b22412fa5552d1d2ad3babef 100644 (file)
--- a/lib/PublicInbox/SearchIdx.pm
+++ b/lib/PublicInbox/SearchIdx.pm
@@ -22,7 +22,7 @@ use POSIX qw(strftime);
 use Fcntl qw(SEEK_SET);
 use Time::Local qw(timegm);
 use PublicInbox::OverIdx;
-use PublicInbox::Spawn qw(run_wait);
+use PublicInbox::Spawn qw(run_wait run_qx);
 use PublicInbox::Git qw(git_unquote);
 use PublicInbox::MsgTime qw(msg_timestamp msg_datestamp);
 use PublicInbox::Address;
@@ -351,23 +351,18 @@ sub index_diff ($$$) {
 }
 
 sub patch_id {
-       my ($self) = @_; # $_[1] is the diff (may be huge)
-       open(my $fh, '+>:utf8', undef) or die "open: $!";
-       open(my $eh, '+>', undef) or die "open: $!";
-       $fh->autoflush(1);
-       print $fh $_[1] or die "print: $!";
-       sysseek($fh, 0, SEEK_SET) or die "sysseek: $!";
-       my $id = ($self->{ibx} // $self->{eidx} // $self)->git->qx(
-                       [qw(patch-id --stable)], {}, { 0 => $fh, 2 => $eh });
-       seek($eh, 0, SEEK_SET) or die "seek: $!";
-       while (<$eh>) { warn $_ }
+       my ($self, $sref) = @_;
+       my $git = ($self->{ibx} // $self->{eidx} // $self)->git;
+       my $opt = { 0 => $sref, 2 => \(my $err) };
+       my $id = run_qx($git->cmd(qw(patch-id --stable)), undef, $opt);
+       warn $err if $err;
        $id =~ /\A([a-f0-9]{40,})/ ? $1 : undef;
 }
 
 sub index_body_text {
        my ($self, $doc, $sref) = @_;
        if ($$sref =~ /^(?:diff|---|\+\+\+) /ms) {
-               my $id = patch_id($self, $$sref);
+               my $id = patch_id($self, $sref);
                $doc->add_term('XDFID'.$id) if defined($id);
        }
 

diff --git a/lib/PublicInbox/Spawn.pm b/lib/PublicInbox/Spawn.pm
index 106f5e01313e358c44ed54623e46f3221f2dcfe2..1fa7a41f87a371336a3b45fd76abe9ead789d63e 100644 (file)
--- a/lib/PublicInbox/Spawn.pm
+++ b/lib/PublicInbox/Spawn.pm
@@ -22,8 +22,9 @@ use Fcntl qw(SEEK_SET);
 use IO::Handle ();
 use Carp qw(croak);
 use PublicInbox::ProcessIO;
-our @EXPORT_OK = qw(which spawn popen_rd popen_wr run_die run_wait);
+our @EXPORT_OK = qw(which spawn popen_rd popen_wr run_die run_wait run_qx);
 our @RLIMITS = qw(RLIMIT_CPU RLIMIT_CORE RLIMIT_DATA);
+use autodie qw(open pipe read seek sysseek truncate);
 
 BEGIN {
        my $all_libc = <<'ALL_LIBC'; # all *nix systems we support
@@ -290,7 +291,6 @@ ALL_LIBC
        undef $all_libc unless -d $inline_dir;
        if (defined $all_libc) {
                local $ENV{PERL_INLINE_DIRECTORY} = $inline_dir;
-               use autodie;
                # CentOS 7.x ships Inline 0.53, 0.64+ has built-in locking
                my $lk = PublicInbox::Lock->new($inline_dir.
                                                '/.public-inbox.lock');
@@ -301,7 +301,7 @@ ALL_LIBC
                open STDERR, '>&', $fh;
                STDERR->autoflush(1);
                STDOUT->autoflush(1);
-               CORE::eval 'use Inline C => $all_libc, BUILD_NOISY => 1';
+               eval 'use Inline C => $all_libc, BUILD_NOISY => 1';
                my $err = $@;
                open(STDERR, '>&', $olderr);
                open(STDOUT, '>&', $oldout);
@@ -332,26 +332,34 @@ sub which ($) {
 }
 
 sub spawn ($;$$) {
-       my ($cmd, $env, $opts) = @_;
+       my ($cmd, $env, $opt) = @_;
        my $f = which($cmd->[0]) // die "$cmd->[0]: command not found\n";
-       my @env;
+       my (@env, @rdr);
        my %env = (%ENV, $env ? %$env : ());
        while (my ($k, $v) = each %env) {
                push @env, "$k=$v" if defined($v);
        }
-       my $redir = [];
        for my $child_fd (0..2) {
-               my $parent_fd = $opts->{$child_fd};
-               if (defined($parent_fd) && $parent_fd !~ /\A[0-9]+\z/) {
-                       my $fd = fileno($parent_fd) //
-                                       die "$parent_fd not an IO GLOB? $!";
-                       $parent_fd = $fd;
+               my $pfd = $opt->{$child_fd};
+               if ('SCALAR' eq ref($pfd)) {
+                       open my $fh, '+>:utf8', undef;
+                       $opt->{"fh.$child_fd"} = $fh;
+                       if ($child_fd == 0) {
+                               print $fh $$pfd;
+                               $fh->flush or die "flush: $!";
+                               sysseek($fh, 0, SEEK_SET);
+                       }
+                       $pfd = fileno($fh);
+               } elsif (defined($pfd) && $pfd !~ /\A[0-9]+\z/) {
+                       my $fd = fileno($pfd) //
+                                       die "$pfd not an IO GLOB? $!";
+                       $pfd = $fd;
                }
-               $redir->[$child_fd] = $parent_fd // $child_fd;
+               $rdr[$child_fd] = $pfd // $child_fd;
        }
        my $rlim = [];
        foreach my $l (@RLIMITS) {
-               my $v = $opts->{$l} // next;
+               my $v = $opt->{$l} // next;
                my $r = eval "require BSD::Resource; BSD::Resource::$l();";
                unless (defined $r) {
                        warn "$l undefined by BSD::Resource: $@\n";
@@ -359,31 +367,41 @@ sub spawn ($;$$) {
                }
                push @$rlim, $r, @$v;
        }
-       my $cd = $opts->{'-C'} // ''; # undef => NULL mapping doesn't work?
-       my $pgid = $opts->{pgid} // -1;
-       my $pid = pi_fork_exec($redir, $f, $cmd, \@env, $rlim, $cd, $pgid);
+       my $cd = $opt->{'-C'} // ''; # undef => NULL mapping doesn't work?
+       my $pgid = $opt->{pgid} // -1;
+       my $pid = pi_fork_exec(\@rdr, $f, $cmd, \@env, $rlim, $cd, $pgid);
        die "fork_exec @$cmd failed: $!\n" unless $pid > 0;
        $pid;
 }
 
 sub popen_rd {
        my ($cmd, $env, $opt, @cb_arg) = @_;
-       pipe(my $r, local $opt->{1}) or die "pipe: $!\n";
+       pipe(my $r, local $opt->{1});
        my $pid = spawn($cmd, $env, $opt);
        PublicInbox::ProcessIO->maybe_new($pid, $r, @cb_arg);
 }
 
 sub popen_wr {
        my ($cmd, $env, $opt, @cb_arg) = @_;
-       pipe(local $opt->{0}, my $w) or die "pipe: $!\n";
+       pipe(local $opt->{0}, my $w);
        $w->autoflush(1);
        my $pid = spawn($cmd, $env, $opt);
        PublicInbox::ProcessIO->maybe_new($pid, $w, @cb_arg)
 }
 
+sub read_out_err ($) {
+       my ($opt) = @_;
+       for my $fd (1, 2) { # read stdout/stderr
+               my $fh = delete($opt->{"fh.$fd"}) // next;
+               seek($fh, 0, SEEK_SET);
+               read($fh, ${$opt->{$fd}}, -s $fh, length(${$opt->{$fd}} // ''));
+       }
+}
+
 sub run_wait ($;$$) {
        my ($cmd, $env, $opt) = @_;
        waitpid(spawn($cmd, $env, $opt), 0);
+       read_out_err($opt);
        $?
 }
 
@@ -392,4 +410,19 @@ sub run_die ($;$$) {
        run_wait($cmd, $env, $rdr) and croak "E: @$cmd failed: \$?=$?";
 }
 
+sub run_qx {
+       my ($cmd, $env, $opt) = @_;
+       my $fh = popen_rd($cmd, $env, $opt);
+       my @ret;
+       if (wantarray) {
+               @ret = <$fh>;
+       } else {
+               local $/;
+               $ret[0] = <$fh>;
+       }
+       close $fh; # caller should check $?
+       read_out_err($opt);
+       wantarray ? @ret : $ret[0];
+}
+
 1;

diff --git a/t/spawn.t b/t/spawn.t
index 1af66bda6110b14bab763eea50b09dbcbabc3a72..4b3baae4e2e5d8b0865dbd1741bd1f8b89f7973f 100644 (file)
--- a/t/spawn.t
+++ b/t/spawn.t
@@ -3,7 +3,7 @@
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 use v5.12;
 use Test::More;
-use PublicInbox::Spawn qw(which spawn popen_rd);
+use PublicInbox::Spawn qw(which spawn popen_rd run_qx);
 require PublicInbox::Sigfd;
 require PublicInbox::DS;
 
@@ -19,6 +19,17 @@ require PublicInbox::DS;
        is($?, 0, 'true exited successfully');
 }
 
+{
+       my $opt = { 0 => \'in', 2 => \(my $e) };
+       my $out = run_qx(['sh', '-c', 'echo e >&2; cat'], undef, $opt);
+       is($e, "e\n", 'captured stderr');
+       is($out, 'in', 'stdin read and stdout captured');
+       $opt->{0} = \"IN\n3\nLINES";
+       my @out = run_qx(['sh', '-c', 'echo E >&2; cat'], undef, $opt);
+       is($e, "e\nE\n", 'captured stderr appended to string');
+       is_deeply(\@out, [ "IN\n", "3\n", 'LINES' ], 'stdout array');
+}
+
 SKIP: {
        my $pid = spawn(['true'], undef, { pgid => 0 });
        ok($pid, 'spawned process with new pgid');