File Coverage

blib/lib/Log/ger/Plugin/WithDie.pm
Criterion Covered Total %
statement 31 31 100.0
branch 6 8 75.0
condition 6 6 100.0
subroutine 13 13 100.0
pod 0 2 0.0
total 56 60 93.3


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-11'; # DATE
5             our $DIST = 'Log-ger-Plugin-WithWarn'; # DIST
6             our $VERSION = '0.004'; # VERSION
7              
8 1     1   66146 use strict;
  1         9  
  1         26  
9 1     1   4 use warnings;
  1         2  
  1         20  
10              
11 1     1   4 use Log::ger ();
  1         2  
  1         485  
12              
13             sub meta { +{
14 1     1 0 14 v => 2,
15             } }
16              
17             sub get_hooks {
18 1     1 0 11 my %plugin_conf = @_;
19              
20             return {
21             create_routine_names => [
22             __PACKAGE__, 50,
23             sub {
24 3     3   1166 my %args = @_;
25              
26 3         6 my $levels = \%Log::ger::Levels;
27              
28             return [{
29             logger_subs => [
30 6         20 (map { ["log_${_}_die", $_, "default"] }
31 18 50       56 grep {$levels->{$_} > 0 && $levels->{$_} <= 20} keys %$levels),
32             ],
33             level_checker_subs => [],
34             logger_methods => [
35 6         23 (map { ["${_}_die", $_, "default"] }
36 3 50       10 grep {$levels->{$_} > 0 && $levels->{$_} <= 20} keys %$levels),
  18         57  
37             ],
38             level_checker_methods => [
39             ],
40             }, 0];
41             }],
42             before_install_routines => [
43             __PACKAGE__, 50,
44             sub {
45 3     3   2672 my %args = @_;
46              
47             # wrap the logger
48 3         6 for my $r (@{ $args{routines} }) {
  3         8  
49 42         73 my ($code, $name, $numlevel, $type) = @$r;
50 42 100 100     167 if ($type =~ /^log(ger)?_sub/ && $name =~ /\Alog_\w+_die\z/) {
    100 100        
51             $r->[0] = sub {
52 2     2   550 $code->(@_);
        2      
53 2         9 die $args{formatters}{default}(@_)."\n";
54 2         7 };
55             } elsif ($type =~ /^log(ger)?_method/ && $name =~ /\A\w+_die\z/) {
56             $r->[0] = sub {
57 2     2   406 $code->(@_);
        2      
        2      
        2      
58 2         6 shift;
59 2         5 die $args{formatters}{default}(@_)."\n";
60 4         16 };
61             }
62             }
63             },
64 1         8 ],
65             };
66             }
67              
68             1;
69             # ABSTRACT: Add *_die logging routines
70              
71             __END__