treewide: run update-copyrights from gnulib for 2019

[public-inbox.git] / lib / PublicInbox / TestCommon.pm

diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm
index 85cda03190ffba4b3373ac94c731e0d80d48a46b..386610ff5cbf6551eb5eda949ee3d8d1536f1776 100644 (file)
--- a/lib/PublicInbox/TestCommon.pm
+++ b/lib/PublicInbox/TestCommon.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2015-2019 all contributors <meta@public-inbox.org>
+# Copyright (C) 2015-2020 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 
 # internal APIs used only for tests
@@ -8,7 +8,7 @@ use parent qw(Exporter);
 use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD :seek);
 use POSIX qw(dup2);
 use IO::Socket::INET;
-our @EXPORT = qw(tmpdir tcp_server tcp_connect require_git
+our @EXPORT = qw(tmpdir tcp_server tcp_connect require_git require_mods
        run_script start_script key2sub);
 
 sub tmpdir (;$) {
@@ -53,11 +53,38 @@ sub require_git ($;$) {
        my $cur_int = ($cur_maj << 24) | ($cur_min << 16);
        if ($cur_int < $req_int) {
                return 0 if $maybe;
-               plan(skip_all => "git $req+ required, have $cur_maj.$cur_min");
+               Test::More::plan(skip_all =>
+                               "git $req+ required, have $cur_maj.$cur_min");
        }
        1;
 }
 
+sub require_mods {
+       my @mods = @_;
+       my $maybe = pop @mods if $mods[-1] =~ /\A[0-9]+\z/;
+       my @need;
+       for my $mod (@mods) {
+               if ($mod eq 'Search::Xapian') {
+                       if (eval { require PublicInbox::Search } &&
+                               PublicInbox::Search::load_xapian()) {
+                               next;
+                       }
+               } elsif ($mod eq 'Search::Xapian::WritableDatabase') {
+                       if (eval { require PublicInbox::SearchIdx } &&
+                               PublicInbox::SearchIdx::load_xapian_writable()){
+                                       next;
+                       }
+               } else {
+                       eval "require $mod";
+               }
+               push @need, $mod if $@;
+       }
+       return unless @need;
+       my $m = join(', ', @need)." missing for $0";
+       Test::More::skip($m, $maybe) if $maybe;
+       Test::More::plan(skip_all => $m)
+}
+
 sub key2script ($) {
        my ($key) = @_;
        return $key if (index($key, '/') >= 0);
@@ -67,12 +94,27 @@ sub key2script ($) {
        'blib/script/'.$key;
 }
 
+my @io_mode = ([ *STDIN{IO}, '<&' ], [ *STDOUT{IO}, '>&' ],
+               [ *STDERR{IO}, '>&' ]);
+
 sub _prepare_redirects ($) {
        my ($fhref) = @_;
-       my @x = ([ \*STDIN, '<&' ], [ \*STDOUT, '>&' ], [ \*STDERR, '>&' ]);
-       for (my $fd = 0; $fd <= $#x; $fd++) {
+       my $orig_io = [];
+       for (my $fd = 0; $fd <= $#io_mode; $fd++) {
                my $fh = $fhref->[$fd] or next;
-               my ($oldfh, $mode) = @{$x[$fd]};
+               my ($oldfh, $mode) = @{$io_mode[$fd]};
+               open my $orig, $mode, $oldfh or die "$$oldfh $mode stash: $!";
+               $orig_io->[$fd] = $orig;
+               open $oldfh, $mode, $fh or die "$$oldfh $mode redirect: $!";
+       }
+       $orig_io;
+}
+
+sub _undo_redirects ($) {
+       my ($orig_io) = @_;
+       for (my $fd = 0; $fd <= $#io_mode; $fd++) {
+               my $fh = $orig_io->[$fd] or next;
+               my ($oldfh, $mode) = @{$io_mode[$fd]};
                open $oldfh, $mode, $fh or die "$$oldfh $mode redirect: $!";
        }
 }
@@ -153,35 +195,40 @@ sub run_script ($;$$) {
        my $spawn_opt = {};
        for my $fd (0..2) {
                my $redir = $opt->{$fd};
-               next unless ref($redir);
-               open my $fh, '+>', undef or die "open: $!";
-               $fhref->[$fd] = $fh;
-               $spawn_opt->{$fd} = fileno($fh);
-               next if $fd > 0;
-               $fh->autoflush(1);
-               print $fh $$redir or die "print: $!";
-               seek($fh, 0, SEEK_SET) or die "seek: $!";
+               my $ref = ref($redir);
+               if ($ref eq 'SCALAR') {
+                       open my $fh, '+>', undef or die "open: $!";
+                       $fhref->[$fd] = $fh;
+                       $spawn_opt->{$fd} = $fh;
+                       next if $fd > 0;
+                       $fh->autoflush(1);
+                       print $fh $$redir or die "print: $!";
+                       seek($fh, 0, SEEK_SET) or die "seek: $!";
+               } elsif ($ref eq 'GLOB') {
+                       $spawn_opt->{$fd} = $fhref->[$fd] = $redir;
+               } elsif ($ref) {
+                       die "unable to deal with $ref $redir";
+               }
        }
        if ($run_mode == 0) {
                # spawn an independent new process, like real-world use cases:
                require PublicInbox::Spawn;
                my $cmd = [ key2script($key), @argv ];
                my $pid = PublicInbox::Spawn::spawn($cmd, $env, $spawn_opt);
-               defined($pid) or die "spawn: $!";
                if (defined $pid) {
                        my $r = waitpid($pid, 0);
                        defined($r) or die "waitpid: $!";
                        $r == $pid or die "waitpid: expected $pid, got $r";
                }
        } else { # localize and run everything in the same process:
-               local *STDIN = *STDIN;
-               local *STDOUT = *STDOUT;
-               local *STDERR = *STDERR;
+               # note: "local *STDIN = *STDIN;" and so forth did not work in
+               # old versions of perl
                local %ENV = $env ? (%ENV, %$env) : %ENV;
                local %SIG = %SIG;
                local $0 = join(' ', @$cmd);
-               _prepare_redirects($fhref);
+               my $orig_io = _prepare_redirects($fhref);
                _run_sub($sub, $key, \@argv);
+               _undo_redirects($orig_io);
        }
 
        # slurp the redirects back into user-supplied strings