File Coverage

blib/lib/Hook/Output/File.pm

Criterion	Covered	Total	%
statement	66	66	100.0
branch	23	32	71.8
condition	5	9	55.5
subroutine	10	10	100.0
pod	1	1	100.0
total	105	118	88.9

package Hook::Output::File;

use strict;
use warnings;
use boolean qw(true false);

use Carp qw(croak);
use File::Spec ();
use Params::Validate ':all';
use Scalar::Util qw(blessed);

our $VERSION = '0.09';

validation_options(
    on_fail => sub
{
    my ($error) = @_;
    chomp $error;
    croak $error;
},
    stack_skip => 2,
);

sub redirect
{
    my $class = shift;
    croak 'Invoke with ' . __PACKAGE__ . "->redirect(...)\n"
      if defined blessed $class || $class ne __PACKAGE__;
    _validate(@_);
    my %opts = @_;

    my @keys   = keys   %opts;
    my @values = values %opts;
    delete @opts{@keys};
    @opts{map uc, @keys} = @values;

    my %streams = map {
        $_ => (exists $opts{$_} && defined $opts{$_}) ? true : false
    } qw(STDOUT STDERR);

    my %paths;
    foreach my $stream (grep $streams{$_}, qw(STDOUT STDERR)) {
        $paths{$stream} = File::Spec->rel2abs($opts{$stream});
    }

    my ($old_out, $old_err);

    if ($streams{'STDOUT'}) {
        open($old_out, '>&', STDOUT)         or croak "Cannot duplicate STDOUT: $!";
        open(STDOUT, '>>', $paths{'STDOUT'}) or croak "Cannot redirect STDOUT: $!";

        my $ofh = select STDOUT;
        $| = true;
        select $ofh;
    }
    if ($streams{'STDERR'}) {
        open($old_err, '>&', STDERR)         or croak "Cannot duplicate STDERR: $!";
        open(STDERR, '>>', $paths{'STDERR'}) or croak "Cannot redirect STDERR: $!";

        my $ofh = select STDERR;
        $| = true;
        select $ofh;
    }

    my %handles;
    $handles{'STDOUT'} = $old_out if $streams{'STDOUT'};
    $handles{'STDERR'} = $old_err if $streams{'STDERR'};

    return bless { handles => { %handles } }, $class;
}

sub _validate
{
    validate(@_, {
        stdout => {
            type => UNDEF | SCALAR,
            optional => true,
        },
        stderr => {
            type => UNDEF | SCALAR,
            optional => true,
        },
    });

    my %opts = @_;

    croak <<'EOT'
Hook::Output::File->redirect(stdout => 'file1',
                             stderr => 'file2');
EOT
      if not defined $opts{stdout}
          || defined $opts{stderr};
}

DESTROY
{
    my $self = shift;

    return unless blessed $self eq __PACKAGE__;

    my %handles = %{$self->{handles}};

    if (exists $handles{'STDOUT'}) {
        close(STDOUT);
        open(STDOUT, '>&', $handles{'STDOUT'}) or croak "Cannot restore STDOUT: $!";
        close($handles{'STDOUT'});
    }
    if (exists $handles{'STDERR'}) {
        close(STDERR);
        open(STDERR, '>&', $handles{'STDERR'}) or croak "Cannot restore STDERR: $!";
        close($handles{'STDERR'});
    }
}

1;
__END__