File Coverage

blib/lib/Log/ger/Plugin/WithWarn.pm
Criterion Covered Total %
statement 30 30 100.0
branch 4 4 100.0
condition 6 6 100.0
subroutine 8 8 100.0
pod 0 1 0.0
total 48 49 97.9


line stmt bran cond sub pod time code
1             package Log::ger::Plugin::WithWarn;
2              
3             our $DATE = '2017-08-04'; # DATE
4             our $VERSION = '0.002'; # VERSION
5              
6 1     1   59158 use strict;
  1         2  
  1         27  
7 1     1   5 use warnings;
  1         1  
  1         26  
8              
9 1     1   5 use Log::ger ();
  1         2  
  1         348  
10              
11             sub get_hooks {
12 1     1 0 24 my %conf = @_;
13              
14             return {
15             create_routine_names => [
16             __PACKAGE__, 50,
17             sub {
18 3     3   2058 my %args = @_;
19              
20 3         6 my $levels = \%Log::ger::Levels;
21              
22             return [{
23             log_subs => [
24 3         18 (map { ["log_${_}_warn", $_, "default"] }
25 18         33 grep {$levels->{$_} == 30} keys %$levels),
26             ],
27             is_subs => [],
28             log_methods => [
29 3         22 (map { ["${_}_warn", $_, "default"] }
30 3         12 grep {$levels->{$_} == 30} keys %$levels),
  18         28  
31             ],
32             logml_methods => [
33             ],
34             is_methods => [
35             ],
36             }, 0];
37             }],
38             before_install_routines => [
39             __PACKAGE__, 50,
40             sub {
41 3     3   2775 my %args = @_;
42              
43             # wrap the logger
44 3         6 for my $r (@{ $args{routines} }) {
  3         8  
45 39         62 my ($code, $name, $numlevel, $type) = @$r;
46 39 100 100     137 if ($type eq 'log_sub' && $name =~ /\Alog_\w+_warn\z/) {
    100 100        
47             $r->[0] = sub {
48 1     1   185 $code->(@_);
49 1         18 warn $args{formatters}{default}(@_)."\n"
50 2         10 };
51             } elsif ($type eq 'log_method' && $name =~ /\A\w+_warn\z/) {
52             $r->[0] = sub {
53 1     1   146 $code->(@_);
54 1         17 shift;
55 1         3 warn $args{formatters}{default}(@_)."\n"
56 1         53 };
57             }
58             }
59             },
60 1         9 ],
61             };
62             }
63              
64             1;
65             # ABSTRACT: Add *_warn logging routines
66              
67             __END__