File: Logger.pm

package info (click to toggle)
libobject-remote-perl 0.003004-1
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 408 kB
  • ctags: 221
  • sloc: perl: 2,365; makefile: 2
file content (346 lines) | stat: -rw-r--r-- 8,447 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
package Object::Remote::Logging::Logger;

use Moo;
use Carp qw(croak);

#TODO sigh invoking a logger with a log level name the same
#as an attribute could happen - restrict attributes to _ prefix
#and restrict log levels to not start with out that prefix?
has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } );
has level_names => ( is => 'ro', required => 1 );
has min_level => ( is => 'ro', required => 1, default => sub { 'info' } );
has max_level => ( is => 'lazy', required => 1 );
has _level_active => ( is => 'lazy' );

#just a stub so it doesn't get to AUTOLOAD
sub BUILD { }
sub DESTROY { }

sub AUTOLOAD {
  my $self = shift;
  (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);

  no strict 'refs';

  if ($method =~ m/^_/) {
    croak "invalid method name $method for " . ref($self);
  }

  if ($method =~ m/^is_(.+)/) {
    my $level_name = $1;
    my $is_method = "is_$level_name";
    *{$is_method} = sub { shift(@_)->_level_active->{$level_name} };
    return $self->$is_method;
  }

  my $level_name = $method;
  *{$level_name} = sub {
    my $self = shift;
    unless(exists($self->_level_active->{$level_name})) {
      croak "$level_name is not a valid log level name";
    }

    $self->_log($level_name, @_);
  };

  return $self->$level_name(@_);
}

sub _build_max_level {
  my ($self) = @_;
  return $self->level_names->[-1];
}

sub _build__level_active {
  my ($self) = @_;
  my $should_log = 0;
  my $min_level = $self->min_level;
  my $max_level = $self->max_level;
  my %active;

  foreach my $level (@{$self->level_names}) {
    if($level eq $min_level) {
      $should_log = 1;
    }

    $active{$level} = $should_log;

    if (defined $max_level && $level eq $max_level) {
      $should_log = 0;
    }
  }

  return \%active;
}

sub _log {
  my ($self, $level, $content, $metadata_in) = @_;
  my %metadata = %$metadata_in;
  my $rendered = $self->_render($level, \%metadata, @$content);
  $self->_output($rendered);
}

sub _create_format_lookup {
  my ($self, $level, $metadata, $content) = @_;
  my $method = $metadata->{method};

  $method = '(none)' unless defined $method;

  return {
    '%' => '%', 'n' => "\n",
    t => $self->_render_time($metadata->{timestamp}),
    r => $self->_render_remote($metadata->{object_remote}),
    s => $self->_render_log(@$content), l => $level,
    c => $metadata->{exporter}, p => $metadata->{caller_package}, m => $method,
    f => $metadata->{filename}, i => $metadata->{line},
    h => $metadata->{hostname}, P => $metadata->{pid},
  };
}

sub _get_format_var_value {
  my ($self, $name, $data) = @_;
  my $val = $data->{$name};
  return $val if defined $val;
  return '(undefined)';
}

sub _render_time {
  my ($self, $time) = @_;
  return scalar(localtime($time));
}

sub _render_remote {
  my ($self, $remote) = @_;
  return 'local' unless defined $remote;
  my $conn_id = $remote->{connection_id};
  $conn_id = '(uninit)' unless defined $conn_id;
  return "remote #$conn_id";
}

sub _render_log {
  my ($self, @content) = @_;
  return join('', @content);
}
sub _render {
  my ($self, $level, $metadata, @content) = @_;
  my $var_table = $self->_create_format_lookup($level, $metadata, [@content]);
  my $template = $self->format;

  $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge;

  chomp($template);
  $template =~ s/\n/\n /g;
  $template .= "\n";
  return $template;
}

sub _output {
  my ($self, $content) = @_;
  print STDERR $content;
}

1;

__END__

=head1 NAME

Object::Remote::Logging::Logger - Format and output a log message

=head1 SYNOPSIS

  use Object::Remote::Logging::Logger;
  use Object::Remote::Logging qw( router arg_levels );

  my $app_output = Object::Remote::Logging::Logger->new(
    level_names => arg_levels, format => '%t %s',
    min_level => 'verbose', max_level => 'info',
  );

  #Selector method can return 0 or more logger
  #objects that will receive the messages
  my $selector = sub {
    my ($generating_package, $metadata) = @_;
    return unless $metadata->{exporter} eq 'App::Logging::Subclass';
    return $app_output;
  };

  #true value as second argument causes the selector
  #to be stored with a weak reference
  router->connect($selector, 1);

  #disconnect the selector from the router
  undef($selector);

  #router will hold this logger forever
  #and send it all log messages
  router->connect(Object::Remote::Logging::Logger->new(
    level_names => arg_levels, format => '%s at %f line %i, log level: %l'
    min_level => 'warn', max_level => 'error',
  ));

=head1 DESCRIPTION

This class receives log messages from an instance of L<Object::Remote::Logging::Router>,
formats them according to configuration, and then outputs them to STDERR. In between
the router and the logger is a selector method which inspects the log message metadata
and can return 0 or more loggers that should receive the log message.

=head1 USAGE

A logger object receives the log messages that are generated and converts them to
formatted log entries then displays them to the end user. Each logger has a set
of active log levels and will only output a log entry if the log message is at
an active log level.

To gain access to the stream of log messages a connection is made to the log router.
A logger can directly connect to the router and receive an unfiltered stream of
log messages or a selector closure can be used instead. The selector will be executed
for each log message with the message metadata and returns a list of 0 or more loggers
that should receive the log message. When the selector is executed the first argument
is the name of the package that generated the log message and the second argument
is a hash reference containing the message metadata.

=head1 METADATA

The message metadata is a hash reference with the following keys:

=over 4

=item message_level

Name of the log level of the message.

=item exporter

Package name of the logging API that was used to generate the log message.

=item caller_package

Name of the package that generated the log message.

=item method

Name of the method the message was generated inside of.

=item timestamp

Unix time of the message generation.

=item pid

Process id of the Perl interpreter the message was generated in.

=item hostname

Hostname of the system where the message was generated.

=item filename

Name of the file the message was generated in.

=item line

Line of the source file the message was generated at.

=item object_remote

This is a reference to another hash that contains the Object::Remote
specific information. The keys are

=over 4

=item connection_id

If the log message was generated on a remote Perl interpreter then the
Object::Remote::Connection id of that interpreter will be available here.

=back

=back

=head1 ATTRIBUTES

=over 4

=item level_names

This is a required attribute. Must be an array ref with the list of log level names
in it. The list must be ordered with the lowest level as element 0 and the highest
level as the last element. There is no default value.

=item min_level

The lowest log level that will be output by the logger. There is no default value.

=item max_level

The highest log level that will be output by the logger. The default value is the
highest level present in level_names.

=item format

The printf style format string to use when rendering the log message. The following
sequences are significant:

=over 4

=item %l

Level name that the log message was generated at.

=item %s

Log message rendered into a string with a leading space before any additional lines in a
multiple line message.

=item %t

Time the log message was generated rendered into a string. The time value is taken from
the Perl interpreter that generated the log message; it is not the time that the logger
received the log message on the local interpreter if the log message was forwarded.

=item %r

Object::Remote connection information rendered into a string.

=item %c

Package name of the logging API that was used to generate the log message.

=item %p

Name of the package that generated the log message.

=item %m

Method name that generated the log message.

=item %f

Filename that the log message was generated in.

=item %i

Line number the log message was generated at.

=item %h

Hostname the log message was generated on.

=item %P

Process id of the Perl interpreter that generated the log message.

=item %%

A literal %.

=item %n

A newline.

=back

=back