|  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__  |