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