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 (;$) {
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) {
+ 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);
'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: $!";
}
}
$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