File Coverage

blib/lib/Log/Minimal/Indent.pm
Criterion Covered Total %
statement 53 58 91.3
branch 8 14 57.1
condition 2 2 100.0
subroutine 16 18 88.8
pod 4 4 100.0
total 83 96 86.4


line stmt bran cond sub pod time code
1             package Log::Minimal::Indent;
2 3     3   188420 use 5.010000;
  3         11  
  3         218  
3 3     3   17 use strict;
  3         5  
  3         97  
4 3     3   27 use warnings;
  3         5  
  3         162  
5              
6             our $VERSION = "0.01";
7              
8 3     3   2383 use Log::Minimal;
  3         74646  
  3         21  
9 3     3   2492 use Guard;
  3         1647  
  3         498  
10              
11              
12             our $PADDING = " ";
13              
14             our @EXPORT_OK = qw/indent_log_guard indent_log_scope/;
15             our @EXPORT = @EXPORT_OK;
16              
17             sub import {
18 3     3   28 my $class = shift;
19 3         5 my $package = caller(0);
20            
21 3 50       18 @_ = @EXPORT unless @_;
22            
23 3         4 my (@export, @args);
24 3         5 my $re_export_ok = qr/^(?:@{[ join '|', @EXPORT_OK ]})$/;
  3         120  
25 3         11 foreach ( @_ ) {
26 6 50       33 if ( /$re_export_ok/ ) {
27 6         14 push @export, $_;
28             } else {
29 0         0 push @args, $_;
30             }
31             }
32            
33 3     3   16 no strict 'refs';
  3         6  
  3         909  
34 3         8 foreach my $f ( @export ) {
35 6         10 *{"$package\::$f"} = \&$f;
  6         32  
36             }
37            
38 3         6 @_ = ('Log::Minimal', @args);
39 3         21 goto &Log::Minimal::import;
40             }
41              
42              
43             my $indent_level = 0;
44              
45             sub forward {
46 4     4 1 3194 my ($class, $tag, $level) = @_;
47 4         20 _level2coderef($level)->("");
48 4         15 $indent_level++;
49             }
50              
51             sub back {
52 4     4 1 7403 my ($class, $tag, $level) = @_;
53 4         9 $indent_level--;
54 4         16 _level2coderef($level)->("");
55             }
56              
57             sub _level2coderef {
58 8   100 8   49 local $_ = uc(shift // '');
59 8 50       116 /^DEBUG$/ ? \&Log::Minimal::debugf :
    100          
    50          
    50          
    50          
60             /^WARN$/ ? \&Log::Minimal::warnf :
61             /^CRITICAL$/ ? \&Log::Minimal::critf :
62             /^MUTE$/ ? \&_empty :
63             /^ERROR$/ ? \&Log::Minimal::croakf : \&Log::Minimal::infof;
64             }
65              
66 4     4   10 sub _empty { }
67              
68              
69             { # Overwrite Log::Minimal's behaviour
70             my $orig_log = \&Log::Minimal::_log;
71 3     3   15 no warnings 'redefine';
  3         5  
  3         973  
72             *Log::Minimal::_log = sub{
73 13     13   10964 my $orig_PRINT = $Log::Minimal::PRINT;
74             local $Log::Minimal::PRINT = sub{
75 13     13   1233 $orig_PRINT->(@_, $indent_level);
76 13         67 };
77 13         50 $orig_log->(@_);
78             };
79             }
80              
81             # Modify the default behaviour of PRINT and DIE
82             $Log::Minimal::PRINT = sub{
83             my ( $time, $type, $message, $trace, $raw_message, $indent_level) = @_;
84             my $indent = $PADDING x $indent_level;
85             warn "$time $indent\[$type] $message at $trace\n";
86             };
87              
88             $Log::Minimal::DIE = sub {
89             my ( $time, $type, $message, $trace, $raw_message, $indent_level) = @_;
90             my $indent = $PADDING x $indent_level;
91             die "$time $indent\[$type] $message at $trace\n";
92             };
93              
94              
95             sub indent_log_guard {
96 0     0 1 0 my @args = @_;
97 0         0 __PACKAGE__->forward(@args);
98 0     0   0 guard{ __PACKAGE__->back(@args) };
  0         0  
99             }
100              
101             sub indent_log_scope {
102 2     2 1 1708 my @args = @_;
103 2         15 __PACKAGE__->forward(@args);
104 2     2   10 @_ = sub{ __PACKAGE__->back(@args) };
  2         1527  
105 2         10 goto &scope_guard;
106             }
107              
108              
109             1;
110             __END__