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


line stmt bran cond sub pod time code
1             #!perl
2             package D::oh;
3              
4 1     1   573 use strict;
  1         2  
  1         20  
5 1     1   3 use warnings;
  1         1  
  1         18  
6              
7 1     1   3 use File::Basename;
  1         1  
  1         50  
8 1     1   318 use File::Spec::Functions qw(catfile tmpdir);
  1         530  
  1         41  
9              
10 1     1   4 use Carp;
  1         2  
  1         35  
11 1     1   377 use IO::Handle;
  1         4332  
  1         30  
12 1     1   463 use JSON;
  1         5604  
  1         6  
13 1     1   452 use Time::HiRes 'gettimeofday';
  1         841  
  1         3  
14              
15 1     1   472 use parent 'Exporter';
  1         202  
  1         5  
16             our @EXPORT_OK;
17              
18             our $VERSION = '1.01';
19              
20             our $ERRFILE = catfile(($ENV{TMPDIR} || tmpdir), 'D\'oh');
21             our $OUTFILE;
22              
23             sub import {
24 1     1   10 push @EXPORT_OK, $_[1];
25 1         59 D'oh->export_to_level(1, @_); #'#
26             }
27              
28             sub AUTOLOAD {
29 3     3   42 my $data;
30 3 100       7 if (@_ > 1) {
    100          
31 1         1 $data = \@_;
32             }
33             elsif (ref $_[0]) {
34 1         1 $data = $_[0];
35             }
36             else {
37 1         2 $data = [$_[0]];
38             }
39              
40 3         43 print STDERR encode_json($data), "\n";
41             }
42              
43             sub date {
44 2 100 66 2 0 78 my($fh) = ($_[0] && $_[0] =~ /^STDOUT$/i ? 'STDOUT' : 'STDERR');
45 2         5 my @gt = gettimeofday();
46 2         11 my @lt = gmtime($gt[0]);
47 2         18 (my $ss = sprintf('%.03f', '.' . $gt[1])) =~ s/^0\.//;
48              
49 2         76 my $string = sprintf "# D'oh: %s [$$] %04d-%02d-%02d %02d:%02d:%02d.%sZ\n",
50             basename($0), $lt[5]+1900, $lt[4]+1, @lt[3,2,1,0], $ss;
51              
52 1     1   248 no strict 'refs';
  1         2  
  1         172  
53 2         93 print $fh $string;
54             }
55              
56             sub stdout {
57 1 50   1 0 473 $OUTFILE = $_[0] if $_[0];
58 1 50       3 unless (defined $OUTFILE) {
59 0         0 warn "filename required to output to";
60 0         0 return;
61             }
62 1 50       72 open(STDOUT, '>>', $OUTFILE) or croak("D'oh can't open $OUTFILE: $!");
63 1         9 STDOUT->autoflush(1);
64             }
65              
66             sub stderr {
67 1 50   1 0 15 $ERRFILE = $_[0] if $_[0];
68 1 50       3 unless (defined $ERRFILE) {
69 0         0 warn "filename required to output to";
70 0         0 return;
71             }
72 1 50       43 open(STDERR, '>>', $ERRFILE) or croak("D'oh can't open $ERRFILE: $!");
73 1         5 STDERR->autoflush(1);
74             }
75              
76             1;
77              
78             __END__