File Coverage

blib/lib/Log/ger/Plugin/MultilevelLog.pm
Criterion Covered Total %
statement 30 38 78.9
branch 4 10 40.0
condition 2 4 50.0
subroutine 9 9 100.0
pod 0 2 0.0
total 45 63 71.4


line stmt bran cond sub pod time code
1             package Log::ger::Plugin::MultilevelLog;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-03-11'; # DATE
5             our $DIST = 'Log-ger'; # DIST
6             our $VERSION = '0.037'; # VERSION
7              
8 1     1   5 use strict;
  1         2  
  1         24  
9 1     1   3 use warnings;
  1         2  
  1         18  
10              
11 1     1   5 use Log::ger::Util;
  1         1  
  1         230  
12              
13             sub meta { +{
14 1     1 0 4 v => 2,
15             } }
16              
17             sub get_hooks {
18 1     1 0 2 my %conf = @_;
19              
20 1   50     5 my $sub_name = $conf{sub_name} || 'log';
21 1   50     3 my $method_name = $conf{method_name} || 'log';
22              
23             return {
24             create_filter => [
25             __PACKAGE__, # key
26             50, # priority
27             sub { # hook
28 1     1   3 my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
29              
30             my $filter = sub {
31 2         6 my $level = Log::ger::Util::numeric_level(shift);
32 2 100       7 return 0 unless $level <= $Log::ger::Current_Level;
33 1         5 {level=>$level};
34 1         3 };
35              
36 1         3 [$filter, 0, 'ml'];
37             },
38             ],
39              
40             create_formatter => [
41             __PACKAGE__, # key
42             50, # priority
43             sub { # hook
44 1     1   2 my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
45              
46             my $formatter =
47              
48             # just like the default formatter, except it accepts first
49             # argument (level)
50             sub {
51 1         2 shift; # level
52 1 50       6 return $_[0] if @_ < 2;
53 0         0 my $fmt = shift;
54 0         0 my @args;
55 0         0 for (@_) {
56 0 0       0 if (!defined($_)) {
    0          
57 0         0 push @args, '';
58             } elsif (ref $_) {
59 0         0 push @args, Log::ger::Util::_dump($_);
60             } else {
61 0         0 push @args, $_;
62             }
63             }
64             # redefine is just a dummy category for perls < 5.22
65             # which don't have 'redundant' yet
66 1 50   1   6 no warnings ($warnings::Bits{'redundant'} ? 'redundant' : 'redefine');
  1         2  
  1         142  
67 0         0 sprintf $fmt, @args;
68 1         3 };
69              
70 1         4 [$formatter, 0, 'ml'];
71             },
72             ],
73              
74             create_routine_names => [
75             __PACKAGE__, # key
76             50, # priority
77             sub { # hook
78 1     1   2 my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
79             return [{
80             logger_subs => [[$sub_name , undef, 'ml', undef, 'ml']],
81             logger_methods => [[$method_name, undef, 'ml', undef, 'ml']],
82 1         5 }, $conf{exclusive}];
83             },
84 1         10 ],
85             };
86             }
87              
88             1;
89             # ABSTRACT: Create a log($LEVEL, ...) subroutine/method
90              
91             __END__