The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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;