lib/Object/Remote/Logging/Logger.pm

   1 package Object::Remote::Logging::Logger;
   2
   3 use Moo;
   4 use Scalar::Util qw(weaken);
   5 use Carp qw(croak);
   6
   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?
  10 has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } );
  11 has level_names => ( is => 'ro', required => 1 );
  12 has min_level => ( is => 'ro', required => 1, default => sub { 'info' } );
  13 has max_level => ( is => 'lazy', required => 1 );
  14 has _level_active => ( is => 'lazy' );
  15
  16 #just a stub so it doesn't get to AUTOLOAD
  17 sub BUILD { }
  18 sub DESTROY { }
  19
  20 sub 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(@_);
  48 }
  49
  50 sub _build_max_level {
  51     my ($self) = @_;
  52     return $self->level_names->[-1];
  53 }
  54
  55 sub _build__level_active {
  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;
  61
  62   foreach my $level (@{$self->level_names}) {
  63     if($level eq $min_level) {
  64       $should_log = 1;
  65     }
  66
  67     $active{$level} = $should_log;
  68
  69     if (defined $max_level && $level eq $max_level) {
  70       $should_log = 0;
  71     }
  72   }
  73
  74   return \%active;
  75 }
  76
  77 sub _log {
  78   my ($self, $level, $content, $metadata_in) = @_;
  79   my %metadata = %$metadata_in;
  80   my $rendered = $self->_render($level, \%metadata, @$content);
  81   $self->_output($rendered);
  82 }
  83
  84 sub _create_format_lookup {
  85   my ($self, $level, $metadata, $content) = @_;
  86   my $method = $metadata->{method};
  87
  88   $method = '(none)' unless defined $method;
  89
  90   return {
  91     '%' => '%', 'n' => "\n",
  92     t => $self->_render_time($metadata->{timestamp}),
  93     r => $self->_render_remote($metadata->{object_remote}),
  94     s => $self->_render_log(@$content), l => $level,
  95     c => $metadata->{controller}, p => $metadata->{package}, m => $method,
  96     f => $metadata->{filename}, i => $metadata->{line},
  97     h => $metadata->{hostname}, P => $metadata->{pid},
  98   };
  99 }
 100
 101 sub _get_format_var_value {
 102   my ($self, $name, $data) = @_;
 103   my $val = $data->{$name};
 104   return $val if defined $val;
 105   return '(undefined)';
 106 }
 107
 108 sub _render_time {
 109   my ($self, $time) = @_;
 110   return scalar(localtime($time));
 111 }
 112
 113 sub _render_remote {
 114   my ($self, $remote) = @_;
 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";
 119 }
 120
 121 sub _render_log {
 122   my ($self, @content) = @_;
 123   return join('', @content);
 124 }
 125 sub _render {
 126   my ($self, $level, $metadata, @content) = @_;
 127   my $var_table = $self->_create_format_lookup($level, $metadata, [@content]);
 128   my $template = $self->format;
 129
 130   $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge;
 131
 132   chomp($template);
 133   $template =~ s/\n/\n /g;
 134   $template .= "\n";
 135   return $template;
 136 }
 137
 138 sub _output {
 139   my ($self, $content) = @_;
 140   print STDERR $content;
 141 }
 142
 143 1;
 144
 145 __END__
 146
 147 =head1 NAME
 148
 149 Object::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) = @_;
 165     return unless $metadata->{controller} eq 'App::Logging::Subclass';
 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
 178   router->connect(Object::Remote::Logging::WarnLogger->new(
 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
 185 This class receives log messages from an instance of L<Object::Remote::Log::Router>,
 186 formats them according to configuration, and then outputs them to STDERR. In between
 187 the router and the logger is a selector method which inspects the log message metadata
 188 and can return 0 or more loggers that should receive the log message.
 189
 190 =head1 USAGE
 191
 192 A logger object receives the log messages that are generated and converts them to
 193 formatted log entries then displays them to the end user. Each logger has a set
 194 of active log levels and will only output a log entry if the log message is at
 195 an active log level.
 196
 197 To gain access to the stream of log messages a connection is made to the log router.
 198 A logger can directly connect to the router and receive an unfiltered stream of
 199 log messages or a selector closure can be used instead. The selector will be executed
 200 for each log message with the message metadata and returns a list of 0 or more loggers
 201 that should receive the log message. When the selector is executed the first argument
 202 is the class name of the package that generated the log message and the second argument
 203 is a hash reference containing the message metadata.
 204
 205 =head1 METADATA
 206
 207 The message metadata is a hash reference with the following keys:
 208
 209 =over 4
 210
 211 =item level
 212
 213 Name of the log level of the message.
 214
 215 =item controller
 216
 217 Name of the sub-class of Object::Remote::Logging in use by
 218 the generating package.
 219
 220 =item package
 221
 222 Name of the package that generated the log message.
 223
 224 =item method
 225
 226 Name of the method the message was generated inside of.
 227
 228 =item timestamp
 229
 230 Unix time of the message generation.
 231
 232 =item pid
 233
 234 Process id of the Perl interpreter the message was generated in.
 235
 236 =item hostname
 237
 238 Hostname of the system where the message was generated.
 239
 240 =item filename
 241
 242 Name of the file the message was generated in.
 243
 244 =item line
 245
 246 Line of the source file the message was generated at.
 247
 248 =item object_remote
 249
 250 This is a reference to another hash that contains the Object::Remote
 251 specific information. The keys are
 252
 253 =over 4
 254
 255 =item connection_id
 256
 257 If the log message was generated on a remote Perl interpreter then the
 258 Object::Remote::Connection id of that interpreter will be available here.
 259
 260 =back
 261
 262 =back
 263
 264 =head1 ATTRIBUTES
 265
 266 =over 4
 267
 268 =item level_names
 269
 270 This is a required attribute. Must be an array ref with the list of log level names
 271 in it. The list must be ordered with the lowest level as element 0 and the highest
 272 level as the last element. There is no default value.
 273
 274 =item min_level
 275
 276 The lowest log level that will be output by the logger. There is no default value.
 277
 278 =item max_level
 279
 280 The highest log level that will be output by the logger. The default value is the
 281 highest level present in level_names.
 282
 283 =item format
 284
 285 The printf style format string to use when rendering the log message. The following
 286 sequences are significant:
 287
 288 =over 4
 289
 290 =item %l
 291
 292 Level name that the log message was generated at.
 293
 294 =item %s
 295
 296 Log message rendered into a string with a leading space before any additional lines in a
 297 multiple line message.
 298
 299 =item %t
 300
 301 Time the log message was generated rendered into a string. The time value is taken from
 302 the Perl interpreter that generated the log message; it is not the time that the logger
 303 received the log message on the local interpreter if the log message was forwarded.
 304
 305 =item %r
 306
 307 Log::Remote connection information rendered into a string.
 308
 309 =item %c
 310
 311 Name of the sub-class of Object::Remote::Logging that was used by the class
 312 that generated the log message. Can also be Object::Remote::Logging itself.
 313
 314 =item %p
 315
 316 Package name of the class that generated the log message.
 317
 318 =item %m
 319
 320 Method name that generated the log message.
 321
 322 =item %f
 323
 324 Filename that the log message was generated in.
 325
 326 =item %i
 327
 328 Line number the log message was generated at.
 329
 330 =item %h
 331
 332 Hostname the log message was generated on.
 333
 334 =item %P
 335
 336 Process id of the Perl interpreter that generated the log message.
 337
 338 =item %%
 339
 340 A literal %.
 341
 342 =item %n
 343
 344 A newline.
 345
 346 =back
 347
 348 =back
 349