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