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