File Coverage

blib/lib/Log/Contextual/Router.pm
Criterion Covered Total %
statement 68 68 100.0
branch 22 28 78.5
condition 2 2 100.0
subroutine 15 15 100.0
pod 0 7 0.0
total 107 120 89.1


line stmt bran cond sub pod time code
1             package Log::Contextual::Router;
2             $Log::Contextual::Router::VERSION = '0.007001';
3             # ABSTRACT: Route messages to loggers
4              
5 19     19   9019 use Moo;
  19         207370  
  19         107  
6 19     19   23468 use Scalar::Util 'blessed';
  19         55  
  19         13710  
7              
8             with 'Log::Contextual::Role::Router',
9             'Log::Contextual::Role::Router::SetLogger',
10             'Log::Contextual::Role::Router::WithLogger',
11             'Log::Contextual::Role::Router::HasLogger';
12              
13             eval {
14             require Log::Log4perl;
15             die if $Log::Log4perl::VERSION < 1.29;
16             Log::Log4perl->wrapper_register(__PACKAGE__)
17             };
18              
19             has _default_logger => (
20             is => 'ro',
21             default => sub { {} },
22             init_arg => undef,
23             );
24              
25             has _package_logger => (
26             is => 'ro',
27             default => sub { {} },
28             init_arg => undef,
29             );
30              
31             has _get_logger => (
32             is => 'ro',
33             default => sub { {} },
34             init_arg => undef,
35             );
36              
37       28 0   sub before_import { }
38              
39             sub after_import {
40 28     28 0 114 my ($self, %import_info) = @_;
41 28         72 my $exporter = $import_info{exporter};
42 28         69 my $target = $import_info{target};
43 28         66 my $config = $import_info{arguments};
44              
45 28 100       176 if (my $l = $exporter->arg_logger($config->{logger})) {
46 7         107 $self->set_logger($l);
47             }
48              
49 28 100       177 if (my $l = $exporter->arg_package_logger($config->{package_logger})) {
50 3         11 $self->_set_package_logger_for($target, $l);
51             }
52              
53 28 100       144 if (my $l = $exporter->arg_default_logger($config->{default_logger})) {
54 4         21 $self->_set_default_logger_for($target, $l);
55             }
56             }
57              
58             sub with_logger {
59 4     4 0 10 my $logger = $_[1];
60 4 100       13 if (ref $logger ne 'CODE') {
61 3 50       27 die 'logger was not a CodeRef or a logger object. Please try again.'
62             unless blessed($logger);
63 3         8 $logger = do {
64 3         6 my $l = $logger;
65 8     8   14 sub { $l }
66 3         11 }
67             }
68 4         15 local $_[0]->_get_logger->{l} = $logger;
69 4         14 $_[2]->();
70             }
71              
72             sub set_logger {
73 18     18 0 51 my $logger = $_[1];
74 18 100       95 if (ref $logger ne 'CODE') {
75 12 50       109 die 'logger was not a CodeRef or a logger object. Please try again.'
76             unless blessed($logger);
77 12         31 $logger = do {
78 12         28 my $l = $logger;
79 94     94   208 sub { $l }
80 12         62 }
81             }
82              
83             warn 'set_logger (or -logger) called more than once! This is a bad idea!'
84 18 100       183 if $_[0]->_get_logger->{l};
85 18         105 $_[0]->_get_logger->{l} = $logger;
86             }
87              
88 2     2 0 17 sub has_logger { !!$_[0]->_get_logger->{l} }
89              
90             sub _set_default_logger_for {
91 4     4   8 my $logger = $_[2];
92 4 50       18 if (ref $logger ne 'CODE') {
93 4 50       26 die 'logger was not a CodeRef or a logger object. Please try again.'
94             unless blessed($logger);
95 4         9 $logger = do {
96 4         8 my $l = $logger;
97 16     16   29 sub { $l }
98 4         17 }
99             }
100 4         2160 $_[0]->_default_logger->{$_[1]} = $logger
101             }
102              
103             sub _set_package_logger_for {
104 3     3   7 my $logger = $_[2];
105 3 50       13 if (ref $logger ne 'CODE') {
106 3 50       15 die 'logger was not a CodeRef or a logger object. Please try again.'
107             unless blessed($logger);
108 3         8 $logger = do {
109 3         4 my $l = $logger;
110 28     28   48 sub { $l }
111 3         17 }
112             }
113 3         19 $_[0]->_package_logger->{$_[1]} = $logger
114             }
115              
116             sub get_loggers {
117 184     184 0 574 my ($self, %info) = @_;
118 184         315 my $package = $info{caller_package};
119 184         306 my $log_level = $info{message_level};
120             my $logger =
121             ( $_[0]->_package_logger->{$package}
122             || $_[0]->_get_logger->{l}
123 184   100     1080 || $_[0]->_default_logger->{$package}
124             || die
125             q( no logger set! you can't try to log something without a logger! ));
126              
127 183         344 $info{caller_level}++;
128 183         422 $logger = $logger->($package, \%info);
129              
130 183 100       488 return $logger if $logger ->${\"is_${log_level}"};
  183         878  
131 45         245 return ();
132             }
133              
134             sub handle_log_request {
135 184     184 0 741 my ($self, %message_info) = @_;
136 184         374 my $generator = $message_info{message_sub};
137 184         308 my $args = $message_info{message_args};
138 184         327 my $log_level = $message_info{message_level};
139              
140 184         302 $message_info{caller_level}++;
141              
142 184 100       596 my @loggers = $self->get_loggers(%message_info)
143             or return;
144              
145 138         595 my @log = $generator->(@$args);
146 136         920 $_->$log_level(@log) for @loggers;
147             }
148              
149             1;
150              
151             __END__