File Coverage

blib/lib/Log/ger/Plugin/WithDie.pm
Criterion Covered Total %
statement 30 30 100.0
branch 6 8 75.0
condition 6 6 100.0
subroutine 12 12 100.0
pod 0 1 0.0
total 54 57 94.7


line stmt bran cond sub pod time code
1             package Log::ger::Plugin::WithDie;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-03-07'; # DATE
5             our $DIST = 'Log-ger-Plugin-WithWarn'; # DIST
6             our $VERSION = '0.003'; # VERSION
7              
8 1     1   68413 use strict;
  1         11  
  1         26  
9 1     1   4 use warnings;
  1         1  
  1         19  
10              
11 1     1   4 use Log::ger ();
  1         1  
  1         444  
12              
13             sub get_hooks {
14 1     1 0 11 my %plugin_conf = @_;
15              
16             return {
17             create_routine_names => [
18             __PACKAGE__, 50,
19             sub {
20 3     3   1212 my %args = @_;
21              
22 3         6 my $levels = \%Log::ger::Levels;
23              
24             return [{
25             logger_subs => [
26 6         21 (map { ["log_${_}_die", $_, "default"] }
27 18 50       57 grep {$levels->{$_} > 0 && $levels->{$_} <= 20} keys %$levels),
28             ],
29             level_checker_subs => [],
30             logger_methods => [
31 6         27 (map { ["${_}_die", $_, "default"] }
32 3 50       11 grep {$levels->{$_} > 0 && $levels->{$_} <= 20} keys %$levels),
  18         49  
33             ],
34             level_checker_methods => [
35             ],
36             }, 0];
37             }],
38             before_install_routines => [
39             __PACKAGE__, 50,
40             sub {
41 3     3   2796 my %args = @_;
42              
43             # wrap the logger
44 3         5 for my $r (@{ $args{routines} }) {
  3         7  
45 42         62 my ($code, $name, $numlevel, $type) = @$r;
46 42 100 100     199 if ($type =~ /^log(ger)?_sub/ && $name =~ /\Alog_\w+_die\z/) {
    100 100        
47             $r->[0] = sub {
48 2     2   577 $code->(@_);
        2      
49 2         9 die $args{formatters}{default}(@_)."\n";
50 2         9 };
51             } elsif ($type =~ /^log(ger)?_method/ && $name =~ /\A\w+_die\z/) {
52             $r->[0] = sub {
53 2     2   435 $code->(@_);
        2      
        2      
        2      
54 2         5 shift;
55 2         5 die $args{formatters}{default}(@_)."\n";
56 4         16 };
57             }
58             }
59             },
60 1         9 ],
61             };
62             }
63              
64             1;
65             # ABSTRACT: Add *_die logging routines
66              
67             __END__