File Coverage

blib/lib/Log/Any/For/Builtins.pm
Criterion Covered Total %
statement 41 52 78.8
branch 12 26 46.1
condition 0 4 0.0
subroutine 10 10 100.0
pod 2 2 100.0
total 65 94 69.1


line stmt bran cond sub pod time code
1             package Log::Any::For::Builtins;
2              
3             our $DATE = '2016-04-18'; # DATE
4             our $VERSION = '0.13'; # VERSION
5              
6 1     1   430 use 5.010001;
  1         2  
7 1     1   3 use strict;
  1         1  
  1         14  
8 1     1   6 use warnings;
  1         1  
  1         24  
9 1     1   655 use Log::Any::IfLOG '$log';
  1         9  
  1         3  
10              
11 1     1   405 use Proc::ChildError qw(explain_child_error);
  1         226  
  1         47  
12 1     1   369 use String::Trim::More qw(ellipsis);
  1         462  
  1         293  
13              
14             our $Max_Log_Output = 1024;
15              
16             sub system {
17 3 50   3 1 4181 if ($log->is_trace) {
18 0         0 $log->tracef("system(): %s", join(" ", @_));
19             }
20 3         5235 my $res = CORE::system(@_);
21 3 50       79 if ($log->is_trace) {
22 0 0       0 $log->tracef("system() child error: %d (%s)",
23             $?, explain_child_error()) if $?;
24             }
25 3         27 $res;
26             }
27              
28             sub readpipe {
29 6     6 1 6033 my $arg = join " ", @_;
30 6 50       32 if ($log->is_trace) {
31 0         0 $log->tracef("readpipe(): %s", $arg);
32             }
33 6         32 my $wa = wantarray;
34 6         10 my $output;
35             my @output;
36 6 100       15 if ($wa) { @output = qx($arg) } else { $output = qx($arg) }
  2         3210  
  4         5162  
37 6 50       122 if ($log->is_trace) {
38 0 0       0 $log->tracef("readpipe() child error: %d (%s)",
39             $?, explain_child_error()) if $?;
40 0 0       0 if ($wa) { $output = join("", @output) }
  0         0  
41 0   0     0 my $len = length($output // '');
42 0 0 0     0 $log->tracef("readpipe() output (%d bytes%s): %s",
43             $len,
44             ($len > $Max_Log_Output ?
45             ", $Max_Log_Output shown" : ""),
46             ellipsis($output // '', $Max_Log_Output+3));
47             }
48 6 100       65 $wa ? @output : $output;
49             }
50              
51             sub import {
52 1     1   5 no strict 'refs';
  1         1  
  1         120  
53              
54 1     1   7 my ($self, @args) = @_;
55 1         1 my $caller = caller();
56              
57 1         2 for my $arg (@args) {
58 2 100       6 if ($arg eq 'system') {
    50          
    50          
59 1         1 *{"$caller\::system"} = \&system;
  1         4  
60             } elsif ($arg eq 'my_qx') {
61             # back compat
62 0         0 *{"$caller\::my_qx"} = \&readpipe;
  0         0  
63             } elsif ($arg eq 'readpipe') {
64 1         1 *{"$caller\::readpipe"} = \&readpipe;
  1         18  
65             } else {
66 0           die "$arg is not exported by ".__PACKAGE__;
67             }
68             }
69             }
70              
71             1;
72             # ABSTRACT: (DEPRECATED) Log builtin functions
73              
74             __END__