File Coverage

blib/lib/Sys/Export/LogAny.pm
Criterion Covered Total %
statement 19 40 47.5
branch 0 12 0.0
condition 0 4 0.0
subroutine 7 17 41.1
pod n/a
total 26 73 35.6


line stmt bran cond sub pod time code
1             package Sys::Export::LogAny;
2              
3             our $VERSION = '0.005'; # VERSION
4             # ABSTRACT: Use Log::Any without depending on it
5              
6              
7 18     18   179 use v5.26;
  18         51  
8 18     18   90 use warnings;
  18         28  
  18         3059  
9              
10 18     18   110 if (eval 'use Log::Any 1.051; 1') {
  18         320  
  18         120  
11             our @ISA= ( 'Log::Any' );
12             Log::Any->import(default_adapter => [ 'Stderr', log_level => 'info' ]);
13             } else {
14             *get_logger= sub { bless {}, 'Sys::Export::LogAny::_Logger'; };
15             *import= sub {
16             my $class= shift;
17             for (@_) {
18             if ($_ eq '$log') {
19             my $caller= caller;
20             my $logger= $class->get_logger($caller);
21 18     18   96 no strict 'refs';
  18         35  
  18         2210  
22             *{$caller . '::log'}= \$logger;
23             }
24             else { die "Can't export '$_'"; }
25             }
26             };
27             }
28              
29             package Sys::Export::LogAny::_Logger {
30 18     18   198 use v5.26;
  18         60  
31 18     18   83 use warnings;
  18         25  
  18         811  
32 18     18   77 use experimental qw( signatures );
  18         60  
  18         113  
33             sub _dump {
34 0     0     state $dumper_loaded= require Data::Dumper;
35 0           chomp(my $s= Data::Dumper->new([$_[0]])->Terse(1)->Sortkeys(1)->Dump);
36 0           $s;
37             }
38 0     0     sub is_info { 1 }
39 0     0     sub info($self, @msg) {
  0            
  0            
  0            
40 0           print STDERR join(' ', @msg)."\n"
41             }
42 0     0     sub infof($self, $fmt, @args) {
  0            
  0            
  0            
  0            
43 0 0         printf STDERR $fmt."\n", map +(ref? _dump($_) : defined? $_ : '(undef)'), @args;
    0          
44             }
45             *error = *warn = *notice = *info;
46             *errorf= *warnf = *noticef= *infof;
47             *is_error= *is_warn= *is_notice= *is_info;
48 0   0 0     sub is_debug { ($ENV{DEBUG} // 0) >= 1 }
49 0   0 0     sub is_trace { ($ENV{DEBUG} // 0) >= 2 }
50 0 0   0     sub debug { is_debug? info (@_) : () }
51 0 0   0     sub debugf { is_debug? infof(@_) : () }
52 0 0   0     sub trace { is_trace? info (@_) : () }
53 0 0   0     sub tracef { is_trace? infof(@_) : () }
54             }
55              
56             1;
57              
58             __END__