update logger metadata documentation to match log-contextual router metadata
[scpubgit/Object-Remote.git] / lib / Object / Remote / Logging / Logger.pm
CommitLineData
4e446335 1package Object::Remote::Logging::Logger;
2
3use Moo;
4use Scalar::Util qw(weaken);
f21127fd 5use 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 10has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } );
4e446335 11has level_names => ( is => 'ro', required => 1 );
f21127fd 12has min_level => ( is => 'ro', required => 1, default => sub { 'info' } );
455d031c 13has max_level => ( is => 'lazy', required => 1 );
4e446335 14has _level_active => ( is => 'lazy' );
15
f21127fd 16#just a stub so it doesn't get to AUTOLOAD
17sub BUILD { }
18sub DESTROY { }
19
20sub 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 50sub _build_max_level {
8f43bcd9 51 my ($self) = @_;
52 return $self->level_names->[-1];
455d031c 53}
54
4e446335 55sub _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 77sub _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 84sub _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,
a663aea5 95 c => $metadata->{exporter}, p => $metadata->{caller_package}, m => $method,
466ee2c4 96 f => $metadata->{filename}, i => $metadata->{line},
97 h => $metadata->{hostname}, P => $metadata->{pid},
454ec6a2 98 };
99}
100
101sub _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
108sub _render_time {
109 my ($self, $time) = @_;
110 return scalar(localtime($time));
111}
112
113sub _render_remote {
114 my ($self, $remote) = @_;
f1d70835 115 return 'local' unless defined $remote;
116 my $conn_id = $remote->{connection_id};
117 $conn_id = '(uninit)' unless defined $conn_id;
118 return "remote #$conn_id";
454ec6a2 119}
120
121sub _render_log {
122 my ($self, @content) = @_;
123 return join('', @content);
124}
4e446335 125sub _render {
c0b2df05 126 my ($self, $level, $metadata, @content) = @_;
454ec6a2 127 my $var_table = $self->_create_format_lookup($level, $metadata, [@content]);
128 my $template = $self->format;
f4a85080 129
466ee2c4 130 $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge;
f4a85080 131
454ec6a2 132 chomp($template);
133 $template =~ s/\n/\n /g;
134 $template .= "\n";
135 return $template;
4e446335 136}
137
138sub _output {
c0b2df05 139 my ($self, $content) = @_;
140 print STDERR $content;
4e446335 141}
142
4e446335 1431;
144
455d031c 145__END__
146
147=head1 NAME
148
149Object::Remote::Logging::Logger - Format and output a log message
150
151=head1 SYNOPSIS
152
153 use Object::Remote::Logging::Logger;
154 use Object::Remote::Logging qw( router arg_levels );
155
156 my $app_output = Object::Remote::Logging::Logger->new(
157 level_names => arg_levels, format => '%t %s',
158 min_level => 'verbose', max_level => 'info',
159 );
160
161 #Selector method can return 0 or more logger
162 #objects that will receive the messages
163 my $selector = sub {
164 my ($generating_package, $metadata) = @_;
977ec25d 165 return unless $metadata->{exporter} eq 'App::Logging::Subclass';
455d031c 166 return $app_output;
167 };
168
169 #true value as second argument causes the selector
170 #to be stored with a weak reference
171 router->connect($selector, 1);
172
173 #disconnect the selector from the router
174 undef($selector);
175
176 #router will hold this logger forever
177 #and send it all log messages
51566265 178 router->connect(Object::Remote::Logging::Logger->new(
455d031c 179 level_names => arg_levels, format => '%s at %f line %i, log level: %l'
180 min_level => 'warn', max_level => 'error',
181 ));
182
183=head1 DESCRIPTION
184
b3e30047 185This class receives log messages from an instance of L<Object::Remote::Logging::Router>,
455d031c 186formats them according to configuration, and then outputs them to STDERR. In between
187the router and the logger is a selector method which inspects the log message metadata
188and can return 0 or more loggers that should receive the log message.
189
190=head1 USAGE
191
192A logger object receives the log messages that are generated and converts them to
193formatted log entries then displays them to the end user. Each logger has a set
194of active log levels and will only output a log entry if the log message is at
195an active log level.
196
197To gain access to the stream of log messages a connection is made to the log router.
198A logger can directly connect to the router and receive an unfiltered stream of
199log messages or a selector closure can be used instead. The selector will be executed
200for each log message with the message metadata and returns a list of 0 or more loggers
201that should receive the log message. When the selector is executed the first argument
b3e30047 202is the name of the package that generated the log message and the second argument
455d031c 203is a hash reference containing the message metadata.
204
205=head1 METADATA
206
207The message metadata is a hash reference with the following keys:
208
209=over 4
210
b3e30047 211=item message_level
455d031c 212
213Name of the log level of the message.
214
b3e30047 215=item exporter
455d031c 216
b3e30047 217Package name of the logging API that was used to generate the log message.
455d031c 218
b3e30047 219=item caller_package
455d031c 220
221Name of the package that generated the log message.
222
223=item method
224
225Name of the method the message was generated inside of.
226
227=item timestamp
228
229Unix time of the message generation.
230
231=item pid
232
233Process id of the Perl interpreter the message was generated in.
234
235=item hostname
236
237Hostname of the system where the message was generated.
238
239=item filename
240
241Name of the file the message was generated in.
242
243=item line
244
245Line of the source file the message was generated at.
246
247=item object_remote
248
249This is a reference to another hash that contains the Object::Remote
250specific information. The keys are
251
252=over 4
253
254=item connection_id
255
256If the log message was generated on a remote Perl interpreter then the
257Object::Remote::Connection id of that interpreter will be available here.
258
259=back
260
261=back
262
263=head1 ATTRIBUTES
264
265=over 4
266
267=item level_names
268
269This is a required attribute. Must be an array ref with the list of log level names
270in it. The list must be ordered with the lowest level as element 0 and the highest
271level as the last element. There is no default value.
272
273=item min_level
274
275The lowest log level that will be output by the logger. There is no default value.
276
277=item max_level
278
279The highest log level that will be output by the logger. The default value is the
280highest level present in level_names.
281
282=item format
283
284The printf style format string to use when rendering the log message. The following
285sequences are significant:
286
287=over 4
288
289=item %l
290
291Level name that the log message was generated at.
292
293=item %s
294
295Log message rendered into a string with a leading space before any additional lines in a
296multiple line message.
297
298=item %t
299
300Time the log message was generated rendered into a string. The time value is taken from
301the Perl interpreter that generated the log message; it is not the time that the logger
302received the log message on the local interpreter if the log message was forwarded.
303
304=item %r
305
1a90d0ee 306Object::Remote connection information rendered into a string.
455d031c 307
308=item %c
309
b3e30047 310Package name of the logging API that was used to generate the log message.
455d031c 311
312=item %p
313
b3e30047 314Name of the package that generated the log message.
455d031c 315
316=item %m
317
318Method name that generated the log message.
319
320=item %f
321
322Filename that the log message was generated in.
323
324=item %i
325
326Line number the log message was generated at.
327
328=item %h
329
330Hostname the log message was generated on.
331
332=item %P
333
334Process id of the Perl interpreter that generated the log message.
335
336=item %%
337
338A literal %.
339
7322b950 340=item %n
341
342A newline.
343
455d031c 344=back
345
346=back
347