File Coverage

blib/lib/D/oh.pm

Criterion	Covered	Total	%
statement	52	56	92.8
branch	12	18	66.6
condition	2	3	66.6
subroutine	15	15	100.0
pod	0	3	0.0
total	81	95	85.2

#!perl
package D::oh;

use strict;
use warnings;

use File::Basename;
use File::Spec::Functions qw(catfile tmpdir);

use Carp;
use IO::Handle;
use JSON;
use Time::HiRes 'gettimeofday';

use parent 'Exporter';
our @EXPORT_OK;

our $VERSION = '1.01';

our $ERRFILE = catfile(($ENV{TMPDIR} || tmpdir), 'D\'oh');
our $OUTFILE;

sub import {
    push @EXPORT_OK, $_[1];
    D'oh->export_to_level(1, @_);  #'#
}

sub AUTOLOAD {
    my $data;
    if (@_ > 1) {
        $data = \@_;
    }
    elsif (ref $_[0]) {
        $data = $_[0];
    }
    else {
        $data = [$_[0]];
    }

    print STDERR encode_json($data), "\n";
}

sub date {
    my($fh) = ($_[0] && $_[0] =~ /^STDOUT$/i ? 'STDOUT' : 'STDERR');
    my @gt = gettimeofday();
    my @lt = gmtime($gt[0]);
    (my $ss = sprintf('%.03f', '.' . $gt[1])) =~ s/^0\.//;

    my $string = sprintf "# D'oh: %s [$$] %04d-%02d-%02d %02d:%02d:%02d.%sZ\n",
        basename($0), $lt[5]+1900, $lt[4]+1, @lt[3,2,1,0], $ss;

    no strict 'refs';
    print $fh $string;
}

sub stdout {
    $OUTFILE = $_[0] if $_[0];
    unless (defined $OUTFILE) {
        warn "filename required to output to";
        return;
    }
    open(STDOUT, '>>', $OUTFILE) or croak("D'oh can't open $OUTFILE: $!");
    STDOUT->autoflush(1);
}

sub stderr {
    $ERRFILE = $_[0] if $_[0];
    unless (defined $ERRFILE) {
        warn "filename required to output to";
        return;
    }
    open(STDERR, '>>', $ERRFILE) or croak("D'oh can't open $ERRFILE: $!");
    STDERR->autoflush(1);
}

1;

__END__