-use Data::Dumper qw( );
-use Test::More tests => 4;
-
-# -------------------------------------
-
-# grab_output()
-#
-# Eval some code and return what was printed to stdout and stderr.
-#
-# Parameters: string of code to eval
-#
-# Returns: listref of [ stdout text, stderr text ]
-#
-sub grab_output($) {
- die 'usage: grab_stderr(string to eval)' if @_ != 1;
- my $code = shift;
- use File::Temp qw(tempdir);
- my $dir = tempdir( CLEANUP => 1 );
- my $tmp_o = "$dir/out"; my $tmp_e = "$dir/err";
- local (*OLDOUT, *OLDERR);
-
- # Try to get a message to the outside world if we die
- local $SIG{__DIE__} = sub { print $_[0]; die $_[0] };
-
- open(OLDOUT, ">&STDOUT") or die "can't dup stdout: $!";
- open(OLDERR, ">&STDERR") or die "can't dup stderr: $!";
- open(STDOUT, ">$tmp_o") or die "can't open stdout to $tmp_o: $!";
- open(STDERR, ">$tmp_e") or die "can't open stderr to $tmp_e: $!";
- eval $code;
- # Doubtful whether most of these messages will ever be seen!
- close(STDOUT) or die "cannot close stdout opened to $tmp_o: $!";
- close(STDERR) or die "cannot close stderr opened to $tmp_e: $!";
- open(STDOUT, ">&OLDOUT") or die "can't dup stdout back again: $!";
- open(STDERR, ">&OLDERR") or die "can't dup stderr back again: $!";
-
- die $@ if $@;
-
- local $/ = undef;
- open (TMP_O, $tmp_o) or die "cannot open $tmp_o: $!";
- open (TMP_E, $tmp_e) or die "cannot open $tmp_e: $!";
- my $o = <TMP_O>; my $e = <TMP_E>;
- close TMP_O or die "cannot close filehandle opened to $tmp_o: $!";
- close TMP_E or die "cannot close filehandle opened to $tmp_e: $!";
- unlink $tmp_o or die "cannot unlink $tmp_o: $!";
- unlink $tmp_e or die "cannot unlink $tmp_e: $!";
-
- return [ $o, $e ];
-}