Commit | Line | Data |
21988035 |
1 | package Object::Remote::Logging::Logger; |
2 | |
3 | use Moo; |
4 | use Scalar::Util qw(weaken); |
5 | |
c0d4da69 |
6 | has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } ); |
21988035 |
7 | has level_names => ( is => 'ro', required => 1 ); |
0f48babd |
8 | has min_level => ( is => 'ro', required => 1, default => 'info' ); |
9 | has max_level => ( is => 'lazy', required => 1 ); |
21988035 |
10 | has _level_active => ( is => 'lazy' ); |
11 | |
12 | sub BUILD { |
7d063a6a |
13 | my ($self) = @_; |
14 | our $METHODS_INSTALLED; |
15 | $self->_install_methods unless $METHODS_INSTALLED; |
21988035 |
16 | } |
17 | |
0f48babd |
18 | sub _build_max_level { |
19 | my ($self) = @_; |
20 | return $self->level_names->[-1]; |
21 | } |
22 | |
21988035 |
23 | sub _build__level_active { |
7d063a6a |
24 | my ($self) = @_; |
25 | my $should_log = 0; |
26 | my $min_level = $self->min_level; |
27 | my $max_level = $self->max_level; |
28 | my %active; |
21988035 |
29 | |
7d063a6a |
30 | foreach my $level (@{$self->level_names}) { |
31 | if($level eq $min_level) { |
32 | $should_log = 1; |
33 | } |
34 | |
35 | $active{$level} = $should_log; |
21988035 |
36 | |
7d063a6a |
37 | if (defined $max_level && $level eq $max_level) { |
38 | $should_log = 0; |
21988035 |
39 | } |
7d063a6a |
40 | } |
41 | |
42 | return \%active; |
21988035 |
43 | } |
44 | |
45 | sub _install_methods { |
7d063a6a |
46 | my ($self) = @_; |
47 | my $should_log = 0; |
48 | our $METHODS_INSTALLED = 1; |
e3085f6e |
49 | |
7d063a6a |
50 | no strict 'refs'; |
e3085f6e |
51 | |
7d063a6a |
52 | foreach my $level (@{$self->level_names}) { |
53 | *{"is_$level"} = sub { shift(@_)->_level_active->{$level} }; |
54 | *{$level} = sub { shift(@_)->_log($level, @_) }; |
55 | } |
21988035 |
56 | } |
57 | |
58 | sub _log { |
7d063a6a |
59 | my ($self, $level, $content, $metadata_in) = @_; |
7d063a6a |
60 | my %metadata = %$metadata_in; |
61 | my $rendered = $self->_render($level, \%metadata, @$content); |
62 | $self->_output($rendered); |
21988035 |
63 | } |
64 | |
e3085f6e |
65 | sub _create_format_lookup { |
66 | my ($self, $level, $metadata, $content) = @_; |
3ef75850 |
67 | my $method = $metadata->{method}; |
68 | |
69 | $method = '(none)' unless defined $method; |
70 | |
e3085f6e |
71 | return { |
72 | '%' => '%', t => $self->_render_time($metadata->{timestamp}), |
73 | r => $self->_render_remote($metadata->{object_remote}), |
5987037e |
74 | s => $self->_render_log(@$content), l => $level, |
a0771eda |
75 | c => $metadata->{controller}, p => $metadata->{package}, m => $method, |
1448c113 |
76 | f => $metadata->{filename}, i => $metadata->{line}, |
77 | h => $metadata->{hostname}, P => $metadata->{pid}, |
e3085f6e |
78 | }; |
79 | } |
80 | |
81 | sub _get_format_var_value { |
82 | my ($self, $name, $data) = @_; |
83 | my $val = $data->{$name}; |
84 | return $val if defined $val; |
1448c113 |
85 | return '(undefined)'; |
e3085f6e |
86 | } |
87 | |
88 | sub _render_time { |
89 | my ($self, $time) = @_; |
90 | return scalar(localtime($time)); |
91 | } |
92 | |
93 | sub _render_remote { |
94 | my ($self, $remote) = @_; |
95 | return 'local' if ! defined $remote || ! defined $remote->{connection_id}; |
96 | return 'remote #' . $remote->{connection_id}; |
97 | } |
98 | |
99 | sub _render_log { |
100 | my ($self, @content) = @_; |
101 | return join('', @content); |
102 | } |
21988035 |
103 | sub _render { |
7d063a6a |
104 | my ($self, $level, $metadata, @content) = @_; |
e3085f6e |
105 | my $var_table = $self->_create_format_lookup($level, $metadata, [@content]); |
106 | my $template = $self->format; |
c3d5ef8a |
107 | |
1448c113 |
108 | $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge; |
c3d5ef8a |
109 | |
e3085f6e |
110 | chomp($template); |
111 | $template =~ s/\n/\n /g; |
112 | $template .= "\n"; |
113 | return $template; |
21988035 |
114 | } |
115 | |
116 | sub _output { |
7d063a6a |
117 | my ($self, $content) = @_; |
118 | print STDERR $content; |
21988035 |
119 | } |
120 | |
21988035 |
121 | 1; |
122 | |
0f48babd |
123 | __END__ |
124 | |
125 | =head1 NAME |
126 | |
127 | Object::Remote::Logging::Logger - Format and output a log message |
128 | |
129 | =head1 SYNOPSIS |
130 | |
131 | use Object::Remote::Logging::Logger; |
132 | use Object::Remote::Logging qw( router arg_levels ); |
133 | |
134 | my $app_output = Object::Remote::Logging::Logger->new( |
135 | level_names => arg_levels, format => '%t %s', |
136 | min_level => 'verbose', max_level => 'info', |
137 | ); |
138 | |
139 | #Selector method can return 0 or more logger |
140 | #objects that will receive the messages |
141 | my $selector = sub { |
142 | my ($generating_package, $metadata) = @_; |
143 | return unless $metadata->{controller} eq 'App::Logging::Subclass'; |
144 | return $app_output; |
145 | }; |
146 | |
147 | #true value as second argument causes the selector |
148 | #to be stored with a weak reference |
149 | router->connect($selector, 1); |
150 | |
151 | #disconnect the selector from the router |
152 | undef($selector); |
153 | |
154 | #router will hold this logger forever |
155 | #and send it all log messages |
156 | router->connect(Object::Remote::Logging::WarnLogger->new( |
157 | level_names => arg_levels, format => '%s at %f line %i, log level: %l' |
158 | min_level => 'warn', max_level => 'error', |
159 | )); |
160 | |
161 | =head1 DESCRIPTION |
162 | |
163 | This class receives log messages from an instance of L<Object::Remote::Log::Router>, |
164 | formats them according to configuration, and then outputs them to STDERR. In between |
165 | the router and the logger is a selector method which inspects the log message metadata |
166 | and can return 0 or more loggers that should receive the log message. |
167 | |
168 | =head1 USAGE |
169 | |
170 | A logger object receives the log messages that are generated and converts them to |
171 | formatted log entries then displays them to the end user. Each logger has a set |
172 | of active log levels and will only output a log entry if the log message is at |
173 | an active log level. |
174 | |
175 | To gain access to the stream of log messages a connection is made to the log router. |
176 | A logger can directly connect to the router and receive an unfiltered stream of |
177 | log messages or a selector closure can be used instead. The selector will be executed |
178 | for each log message with the message metadata and returns a list of 0 or more loggers |
179 | that should receive the log message. When the selector is executed the first argument |
180 | is the class name of the package that generated the log message and the second argument |
181 | is a hash reference containing the message metadata. |
182 | |
183 | =head1 METADATA |
184 | |
185 | The message metadata is a hash reference with the following keys: |
186 | |
187 | =over 4 |
188 | |
189 | =item level |
190 | |
191 | Name of the log level of the message. |
192 | |
193 | =item controller |
194 | |
195 | Name of the sub-class of Object::Remote::Logging in use by |
196 | the generating package. |
197 | |
198 | =item package |
199 | |
200 | Name of the package that generated the log message. |
201 | |
202 | =item method |
203 | |
204 | Name of the method the message was generated inside of. |
205 | |
206 | =item timestamp |
207 | |
208 | Unix time of the message generation. |
209 | |
210 | =item pid |
211 | |
212 | Process id of the Perl interpreter the message was generated in. |
213 | |
214 | =item hostname |
215 | |
216 | Hostname of the system where the message was generated. |
217 | |
218 | =item filename |
219 | |
220 | Name of the file the message was generated in. |
221 | |
222 | =item line |
223 | |
224 | Line of the source file the message was generated at. |
225 | |
226 | =item object_remote |
227 | |
228 | This is a reference to another hash that contains the Object::Remote |
229 | specific information. The keys are |
230 | |
231 | =over 4 |
232 | |
233 | =item connection_id |
234 | |
235 | If the log message was generated on a remote Perl interpreter then the |
236 | Object::Remote::Connection id of that interpreter will be available here. |
237 | |
238 | =back |
239 | |
240 | =back |
241 | |
242 | =head1 ATTRIBUTES |
243 | |
244 | =over 4 |
245 | |
246 | =item level_names |
247 | |
248 | This is a required attribute. Must be an array ref with the list of log level names |
249 | in it. The list must be ordered with the lowest level as element 0 and the highest |
250 | level as the last element. There is no default value. |
251 | |
252 | =item min_level |
253 | |
254 | The lowest log level that will be output by the logger. There is no default value. |
255 | |
256 | =item max_level |
257 | |
258 | The highest log level that will be output by the logger. The default value is the |
259 | highest level present in level_names. |
260 | |
261 | =item format |
262 | |
263 | The printf style format string to use when rendering the log message. The following |
264 | sequences are significant: |
265 | |
266 | =over 4 |
267 | |
268 | =item %l |
269 | |
270 | Level name that the log message was generated at. |
271 | |
272 | =item %s |
273 | |
274 | Log message rendered into a string with a leading space before any additional lines in a |
275 | multiple line message. |
276 | |
277 | =item %t |
278 | |
279 | Time the log message was generated rendered into a string. The time value is taken from |
280 | the Perl interpreter that generated the log message; it is not the time that the logger |
281 | received the log message on the local interpreter if the log message was forwarded. |
282 | |
283 | =item %r |
284 | |
285 | Log::Remote connection information rendered into a string. |
286 | |
287 | =item %c |
288 | |
289 | Name of the sub-class of Object::Remote::Logging that was used by the class |
290 | that generated the log message. Can also be Object::Remote::Logging itself. |
291 | |
292 | =item %p |
293 | |
294 | Package name of the class that generated the log message. |
295 | |
296 | =item %m |
297 | |
298 | Method name that generated the log message. |
299 | |
300 | =item %f |
301 | |
302 | Filename that the log message was generated in. |
303 | |
304 | =item %i |
305 | |
306 | Line number the log message was generated at. |
307 | |
308 | =item %h |
309 | |
310 | Hostname the log message was generated on. |
311 | |
312 | =item %P |
313 | |
314 | Process id of the Perl interpreter that generated the log message. |
315 | |
316 | =item %% |
317 | |
318 | A literal %. |
319 | |
320 | =back |
321 | |
322 | =back |
323 | |