]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/TestCommon.pm
testcommon: allow OR-ing module dependencies
[public-inbox.git] / lib / PublicInbox / TestCommon.pm
index 6e3e9d8c8f506a92b195f15c4cd558a60b8ef31a..a97125e59850a391bcef929bf63b5b8acdc6395e 100644 (file)
@@ -5,11 +5,19 @@
 package PublicInbox::TestCommon;
 use strict;
 use parent qw(Exporter);
+use v5.10.1;
 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 require_mods
-       run_script start_script key2sub);
+       run_script start_script key2sub xsys xqx eml_load);
+
+sub eml_load ($) {
+       my ($path, $cb) = @_;
+       open(my $fh, '<', $path) or die "open $path: $!";
+       require PublicInbox::Eml;
+       PublicInbox::Eml->new(\(do { local $/; <$fh> }));
+}
 
 sub tmpdir (;$) {
        my ($base) = @_;
@@ -29,17 +37,18 @@ sub tcp_server () {
                Type => Socket::SOCK_STREAM(),
                Listen => 1024,
                Blocking => 0,
-       )
+       ) or Test::More::BAIL_OUT("failed to create TCP server: $!");
 }
 
 sub tcp_connect {
        my ($dest, %opt) = @_;
+       my $addr = $dest->sockhost . ':' . $dest->sockport;
        my $s = IO::Socket::INET->new(
                Proto => 'tcp',
                Type => Socket::SOCK_STREAM(),
-               PeerAddr => $dest->sockhost . ':' . $dest->sockport,
+               PeerAddr => $addr,
                %opt,
-       );
+       ) or Test::More::BAIL_OUT("failed to connect to $addr: $!");
        $s->autoflush(1);
        $s;
 }
@@ -63,7 +72,7 @@ sub require_mods {
        my @mods = @_;
        my $maybe = pop @mods if $mods[-1] =~ /\A[0-9]+\z/;
        my @need;
-       for my $mod (@mods) {
+       while (my $mod = shift(@mods)) {
                if ($mod eq 'Search::Xapian') {
                        if (eval { require PublicInbox::Search } &&
                                PublicInbox::Search::load_xapian()) {
@@ -74,6 +83,15 @@ sub require_mods {
                                PublicInbox::SearchIdx::load_xapian_writable()){
                                        next;
                        }
+               } elsif (index($mod, '||') >= 0) { # "Foo||Bar"
+                       my $ok;
+                       for my $m (split(/\Q||\E/, $mod)) {
+                               eval "require $m";
+                               next if $@;
+                               $ok = $m;
+                               last;
+                       }
+                       next if $ok;
                } else {
                        eval "require $mod";
                }
@@ -87,7 +105,7 @@ sub require_mods {
 
 sub key2script ($) {
        my ($key) = @_;
-       return $key if (index($key, '/') >= 0);
+       return $key if ($key eq 'git' || index($key, '/') >= 0);
        # n.b. we may have scripts which don't start with "public-inbox" in
        # the future:
        $key =~ s/\A([-\.])/public-inbox$1/;
@@ -242,7 +260,61 @@ sub run_script ($;$$) {
        $? == 0;
 }
 
-sub wait_for_tail () { sleep(2) }
+sub tick (;$) {
+       my $tick = shift // 0.1;
+       select undef, undef, undef, $tick;
+       1;
+}
+
+sub wait_for_tail ($;$) {
+       my ($tail_pid, $stop) = @_;
+       my $wait = 2;
+       if ($^O eq 'linux') { # GNU tail may use inotify
+               state $tail_has_inotify;
+               return tick if $stop && $tail_has_inotify;
+               my $end = time + $wait;
+               my @ino;
+               do {
+                       @ino = grep {
+                               readlink($_) =~ /\binotify\b/
+                       } glob("/proc/$tail_pid/fd/*");
+               } while (!@ino && time <= $end and tick);
+               return if !@ino;
+               $tail_has_inotify = 1;
+               $ino[0] =~ s!/fd/!/fdinfo/!;
+               my @info;
+               do {
+                       if (open my $fh, '<', $ino[0]) {
+                               local $/ = "\n";
+                               @info = grep(/^inotify wd:/, <$fh>);
+                       }
+               } while (scalar(@info) < 2 && time <= $end and tick);
+       } else {
+               sleep($wait);
+       }
+}
+
+# like system() built-in, but uses spawn() for env/rdr + vfork
+sub xsys {
+       my ($cmd, $env, $rdr) = @_;
+       if (ref($cmd)) {
+               $rdr ||= {};
+       } else {
+               $cmd = [ @_ ];
+               $env = undef;
+               $rdr = {};
+       }
+       run_script($cmd, $env, { %$rdr, run_mode => 0 });
+       $? >> 8
+}
+
+# like `backtick` or qx{} op, but uses spawn() for env/rdr + vfork
+sub xqx {
+       my ($cmd, $env, $rdr) = @_;
+       $rdr //= {};
+       run_script($cmd, $env, { %$rdr, run_mode => 0, 1 => \(my $out) });
+       wantarray ? split(/^/m, $out) : $out;
+}
 
 sub start_script {
        my ($cmd, $env, $opt) = @_;
@@ -265,7 +337,7 @@ sub start_script {
                                exec(split(' ', $tail_cmd), @paths);
                                die "$tail_cmd failed: $!";
                        }
-                       wait_for_tail();
+                       wait_for_tail($tail_pid);
                }
        }
        defined(my $pid = fork) or die "fork: $!\n";
@@ -319,8 +391,9 @@ sub kill {
 }
 
 sub join {
-       my ($self) = @_;
+       my ($self, $sig) = @_;
        my $pid = delete $self->{pid} or return;
+       CORE::kill($sig, $pid) if defined $sig;
        my $ret = waitpid($pid, 0);
        defined($ret) or die "waitpid($pid): $!";
        $ret == $pid or die "waitpid($pid) != $ret";
@@ -329,12 +402,11 @@ sub join {
 sub DESTROY {
        my ($self) = @_;
        return if $self->{owner} != $$;
-       if (my $tail = delete $self->{tail_pid}) {
-               PublicInbox::TestCommon::wait_for_tail();
-               CORE::kill('TERM', $tail);
+       if (my $tail_pid = delete $self->{tail_pid}) {
+               PublicInbox::TestCommon::wait_for_tail($tail_pid, 1);
+               CORE::kill('TERM', $tail_pid);
        }
-       my $pid = delete $self->{pid} or return;
-       CORE::kill('TERM', $pid);
+       $self->join('TERM');
 }
 
 1;