File Coverage

blib/lib/Log/ger/Output/Perl.pm
Criterion Covered Total %
statement 34 34 100.0
branch 13 16 81.2
condition 2 5 40.0
subroutine 7 7 100.0
pod 0 2 0.0
total 56 64 87.5


line stmt bran cond sub pod time code
1             package Log::ger::Output::Perl;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-03-11'; # DATE
5             our $DIST = 'Log-ger-Output-Perl'; # DIST
6             our $VERSION = '0.004'; # VERSION
7              
8 1     1   3441 use 5.010001;
  1         3  
9 1     1   5 use strict;
  1         1  
  1         16  
10 1     1   4 use warnings;
  1         1  
  1         18  
11 1     1   4 use Log::ger::Util ();
  1         2  
  1         300  
12              
13             sub meta { +{
14 1     1 0 16 v => 2,
15             } }
16              
17             sub get_hooks {
18 1     1 0 14 my %plugin_conf = @_;
19              
20 1   50     4 my $action = delete($plugin_conf{action}) || {
21             warn => 'warn',
22             error => 'warn',
23             fatal => 'die',
24             };
25 1 50       4 keys %plugin_conf and die "Unknown configuration: ".
26             join(", ", sort keys %plugin_conf);
27              
28             return {
29             create_outputter => [
30             __PACKAGE__, # key
31             # we want to handle all levels, thus we need to be higher priority
32             # than default Log::ger hooks (10) which will install null loggers
33             # for less severe levels.
34             9, # priority
35             sub { # hook
36 6     6   688 my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
37              
38             my $outputter = sub {
39 6         5204 my ($per_target_conf, $msg, $per_msg_conf) = @_;
40 6   33     26 my $lvl = $per_msg_conf->{level} // $hook_args{level};
41 6 50       15 if (my $act =
42             $action->{Log::ger::Util::string_level($lvl)}) {
43 6 50       108 @_ = ref $msg eq 'ARRAY' ? @$msg : ($msg);
44 6 100       19 if ($act eq 'warn') {
    100          
    100          
    100          
    100          
45 1         13 warn @_;
46             } elsif ($act eq 'carp') {
47 1         5 require Carp;
48 1         19 goto &Carp::carp;
49             } elsif ($act eq 'cluck') {
50 1         4 require Carp;
51 1         13 goto &Carp::cluck;
52             } elsif ($act eq 'croak') {
53 1         5 require Carp;
54 1         44 goto &Carp::croak;
55             } elsif ($act eq 'confess') {
56 1         5 require Carp;
57 1         12 goto &Carp::confess;
58             } else {
59             # die is the default action if unknown
60 1         10 die @_;
61             }
62             }
63 6         29 };
64 6         14 [$outputter];
65 1         7 }],
66             };
67             }
68              
69             1;
70             # ABSTRACT: Log to Perl's standard facility (warn, die, etc)
71              
72             __END__