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