Commit | Line | Data |
4e446335 |
1 | package Object::Remote::Logging::Logger; |
2 | |
3 | use Moo; |
f21127fd |
4 | use Carp qw(croak); |
4e446335 |
5 | |
f21127fd |
6 | #TODO sigh invoking a logger with a log level name the same |
7 | #as an attribute could happen - restrict attributes to _ prefix |
8 | #and restrict log levels to not start with out that prefix? |
0fe333eb |
9 | has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } ); |
4e446335 |
10 | has level_names => ( is => 'ro', required => 1 ); |
f21127fd |
11 | has min_level => ( is => 'ro', required => 1, default => sub { 'info' } ); |
455d031c |
12 | has max_level => ( is => 'lazy', required => 1 ); |
4e446335 |
13 | has _level_active => ( is => 'lazy' ); |
14 | |
f21127fd |
15 | #just a stub so it doesn't get to AUTOLOAD |
16 | sub BUILD { } |
17 | sub DESTROY { } |
18 | |
19 | sub AUTOLOAD { |
20 | my $self = shift; |
21 | (my $method) = (our $AUTOLOAD =~ /([^:]+)$/); |
22 | |
23 | no strict 'refs'; |
24 | |
25 | if ($method =~ m/^_/) { |
26 | croak "invalid method name $method for " . ref($self); |
27 | } |
28 | |
29 | if ($method =~ m/^is_(.+)/) { |
30 | my $level_name = $1; |
31 | my $is_method = "is_$level_name"; |
32 | *{$is_method} = sub { shift(@_)->_level_active->{$level_name} }; |
33 | return $self->$is_method; |
34 | } |
35 | |
36 | my $level_name = $method; |
37 | *{$level_name} = sub { |
38 | my $self = shift; |
39 | unless(exists($self->_level_active->{$level_name})) { |
40 | croak "$level_name is not a valid log level name"; |
41 | } |
42 | |
43 | $self->_log($level_name, @_); |
44 | }; |
55c0d020 |
45 | |
f21127fd |
46 | return $self->$level_name(@_); |
4e446335 |
47 | } |
48 | |
455d031c |
49 | sub _build_max_level { |
8f43bcd9 |
50 | my ($self) = @_; |
51 | return $self->level_names->[-1]; |
455d031c |
52 | } |
53 | |
4e446335 |
54 | sub _build__level_active { |
55c0d020 |
55 | my ($self) = @_; |
c0b2df05 |
56 | my $should_log = 0; |
57 | my $min_level = $self->min_level; |
58 | my $max_level = $self->max_level; |
59 | my %active; |
55c0d020 |
60 | |
c0b2df05 |
61 | foreach my $level (@{$self->level_names}) { |
62 | if($level eq $min_level) { |
55c0d020 |
63 | $should_log = 1; |
c0b2df05 |
64 | } |
65 | |
66 | $active{$level} = $should_log; |
55c0d020 |
67 | |
c0b2df05 |
68 | if (defined $max_level && $level eq $max_level) { |
69 | $should_log = 0; |
4e446335 |
70 | } |
c0b2df05 |
71 | } |
72 | |
73 | return \%active; |
4e446335 |
74 | } |
75 | |
4e446335 |
76 | sub _log { |
c0b2df05 |
77 | my ($self, $level, $content, $metadata_in) = @_; |
c0b2df05 |
78 | my %metadata = %$metadata_in; |
79 | my $rendered = $self->_render($level, \%metadata, @$content); |
80 | $self->_output($rendered); |
4e446335 |
81 | } |
82 | |
454ec6a2 |
83 | sub _create_format_lookup { |
84 | my ($self, $level, $metadata, $content) = @_; |
b43174a1 |
85 | my $method = $metadata->{method}; |
55c0d020 |
86 | |
b43174a1 |
87 | $method = '(none)' unless defined $method; |
55c0d020 |
88 | |
89 | return { |
293fb1ee |
90 | '%' => '%', 'n' => "\n", |
91 | t => $self->_render_time($metadata->{timestamp}), |
454ec6a2 |
92 | r => $self->_render_remote($metadata->{object_remote}), |
55c0d020 |
93 | s => $self->_render_log(@$content), l => $level, |
a663aea5 |
94 | c => $metadata->{exporter}, p => $metadata->{caller_package}, m => $method, |
55c0d020 |
95 | f => $metadata->{filename}, i => $metadata->{line}, |
466ee2c4 |
96 | h => $metadata->{hostname}, P => $metadata->{pid}, |
454ec6a2 |
97 | }; |
98 | } |
99 | |
100 | sub _get_format_var_value { |
101 | my ($self, $name, $data) = @_; |
102 | my $val = $data->{$name}; |
103 | return $val if defined $val; |
466ee2c4 |
104 | return '(undefined)'; |
454ec6a2 |
105 | } |
106 | |
107 | sub _render_time { |
108 | my ($self, $time) = @_; |
109 | return scalar(localtime($time)); |
110 | } |
111 | |
112 | sub _render_remote { |
113 | my ($self, $remote) = @_; |
f1d70835 |
114 | return 'local' unless defined $remote; |
115 | my $conn_id = $remote->{connection_id}; |
116 | $conn_id = '(uninit)' unless defined $conn_id; |
117 | return "remote #$conn_id"; |
454ec6a2 |
118 | } |
119 | |
120 | sub _render_log { |
121 | my ($self, @content) = @_; |
122 | return join('', @content); |
123 | } |
4e446335 |
124 | sub _render { |
c0b2df05 |
125 | my ($self, $level, $metadata, @content) = @_; |
454ec6a2 |
126 | my $var_table = $self->_create_format_lookup($level, $metadata, [@content]); |
127 | my $template = $self->format; |
55c0d020 |
128 | |
466ee2c4 |
129 | $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge; |
55c0d020 |
130 | |
454ec6a2 |
131 | chomp($template); |
132 | $template =~ s/\n/\n /g; |
133 | $template .= "\n"; |
134 | return $template; |
4e446335 |
135 | } |
136 | |
137 | sub _output { |
c0b2df05 |
138 | my ($self, $content) = @_; |
139 | print STDERR $content; |
4e446335 |
140 | } |
141 | |
4e446335 |
142 | 1; |
143 | |
455d031c |
144 | __END__ |
145 | |
146 | =head1 NAME |
147 | |
148 | Object::Remote::Logging::Logger - Format and output a log message |
149 | |
150 | =head1 SYNOPSIS |
151 | |
152 | use Object::Remote::Logging::Logger; |
153 | use Object::Remote::Logging qw( router arg_levels ); |
55c0d020 |
154 | |
455d031c |
155 | my $app_output = Object::Remote::Logging::Logger->new( |
156 | level_names => arg_levels, format => '%t %s', |
157 | min_level => 'verbose', max_level => 'info', |
158 | ); |
159 | |
160 | #Selector method can return 0 or more logger |
161 | #objects that will receive the messages |
162 | my $selector = sub { |
163 | my ($generating_package, $metadata) = @_; |
977ec25d |
164 | return unless $metadata->{exporter} eq 'App::Logging::Subclass'; |
455d031c |
165 | return $app_output; |
166 | }; |
167 | |
168 | #true value as second argument causes the selector |
169 | #to be stored with a weak reference |
170 | router->connect($selector, 1); |
171 | |
172 | #disconnect the selector from the router |
173 | undef($selector); |
55c0d020 |
174 | |
455d031c |
175 | #router will hold this logger forever |
176 | #and send it all log messages |
51566265 |
177 | router->connect(Object::Remote::Logging::Logger->new( |
455d031c |
178 | level_names => arg_levels, format => '%s at %f line %i, log level: %l' |
179 | min_level => 'warn', max_level => 'error', |
180 | )); |
181 | |
182 | =head1 DESCRIPTION |
183 | |
b3e30047 |
184 | This class receives log messages from an instance of L<Object::Remote::Logging::Router>, |
455d031c |
185 | formats them according to configuration, and then outputs them to STDERR. In between |
186 | the router and the logger is a selector method which inspects the log message metadata |
187 | and can return 0 or more loggers that should receive the log message. |
188 | |
189 | =head1 USAGE |
190 | |
191 | A logger object receives the log messages that are generated and converts them to |
192 | formatted log entries then displays them to the end user. Each logger has a set |
193 | of active log levels and will only output a log entry if the log message is at |
55c0d020 |
194 | an active log level. |
455d031c |
195 | |
196 | To gain access to the stream of log messages a connection is made to the log router. |
197 | A logger can directly connect to the router and receive an unfiltered stream of |
198 | log messages or a selector closure can be used instead. The selector will be executed |
199 | for each log message with the message metadata and returns a list of 0 or more loggers |
200 | that should receive the log message. When the selector is executed the first argument |
b3e30047 |
201 | is the name of the package that generated the log message and the second argument |
455d031c |
202 | is a hash reference containing the message metadata. |
203 | |
204 | =head1 METADATA |
205 | |
206 | The message metadata is a hash reference with the following keys: |
207 | |
208 | =over 4 |
209 | |
b3e30047 |
210 | =item message_level |
455d031c |
211 | |
212 | Name of the log level of the message. |
213 | |
b3e30047 |
214 | =item exporter |
455d031c |
215 | |
b3e30047 |
216 | Package name of the logging API that was used to generate the log message. |
455d031c |
217 | |
b3e30047 |
218 | =item caller_package |
455d031c |
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 |
55c0d020 |
269 | in it. The list must be ordered with the lowest level as element 0 and the highest |
455d031c |
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 | |
55c0d020 |
294 | Log message rendered into a string with a leading space before any additional lines in a |
455d031c |
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 | |
1a90d0ee |
305 | Object::Remote connection information rendered into a string. |
455d031c |
306 | |
307 | =item %c |
308 | |
b3e30047 |
309 | Package name of the logging API that was used to generate the log message. |
455d031c |
310 | |
311 | =item %p |
312 | |
b3e30047 |
313 | Name of the package that generated the log message. |
455d031c |
314 | |
315 | =item %m |
316 | |
317 | Method name that generated the log message. |
318 | |
319 | =item %f |
320 | |
321 | Filename that the log message was generated in. |
322 | |
323 | =item %i |
324 | |
325 | Line number the log message was generated at. |
326 | |
327 | =item %h |
328 | |
329 | Hostname the log message was generated on. |
330 | |
331 | =item %P |
332 | |
333 | Process id of the Perl interpreter that generated the log message. |
334 | |
335 | =item %% |
336 | |
337 | A literal %. |
338 | |
7322b950 |
339 | =item %n |
340 | |
341 | A newline. |
342 | |
455d031c |
343 | =back |
344 | |
345 | =back |
346 | |