lib/Object/Remote/Logging/Logger.pm

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