package t::Utils; use strict; use warnings; use Test::More; if ($^O =~ /MSWin|cygwin/) { BAIL_OUT("OS unsupported"); } use Carp; require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw( devnull_stderr devnull_stdout restore_stderr restore_stdout xsystem xqx xprint xopen xclose xecho ); my $stderr_backup; my $stdout_backup; BEGIN { # recreating tfiles use File::Path; rmtree('tfiles'); if (-d 'tfiles') { die "Failed to delete tfiles"; } mkdir 'tfiles' or die "Can't create tfiles: $!"; } sub devnull_stderr() { open($stderr_backup, ">&STDERR") or die "Can't dup STDERR: $!"; open(STDERR, '>/dev/null') or die "Can't dup STDERR: $!"; } sub restore_stderr() { open(STDERR, '>&', $stderr_backup) or die "Can't dup STDERR: $!"; } sub devnull_stdout() { open($stdout_backup, ">&STDOUT") or die "Can't dup STDOUT: $!"; open(STDOUT, '>/dev/null') or die "Can't dup STDOUT: $!"; } sub restore_stdout() { open(STDOUT, '>&', $stdout_backup) or die "Can't dup STDOUT: $!"; } # exception version of builtin 'system' call sub xsystem (@) { return if system(@_) == 0; if ($? == -1) { croak "failed to execute '@_': $!"; } elsif ($? & 127) { croak "'@_' died with signal %d, %s coredump", ($? & 127), ($? & 128) ? 'with' : 'without'; } else { croak sprintf "'@_' exited with value %d\n", $? >> 8; } } sub xopen ($;$) { my ($mode, $file) = @_; my $fh; unless (defined $file) { open $fh, $mode or croak "open '$mode ' failed: $!"; } else { open $fh, $mode, $file or croak "open '$mode$file' failed: $!"; } return $fh; } sub xclose ($) { my ($fh) = @_; close $fh or croak "close failed: $!"; return; } sub xprint ($@) { my $fh = shift; print $fh @_ or croak "print failed: $!"; return; } sub xqx (@) { # exception version of builtin 'qx{}' call my $res = qx{@_}; croak "xqx '@_' failed: $?" if $? != 0; return $res; } sub xecho($$) { # fill file with given content my ($content, $file) = @_; my $fh = xopen('>', $file); print {$fh} "$content\n"; xclose($fh); } 1;