lib/Object/Remote/Logging/Logger.pm

   1 package Object::Remote::Logging::Logger;
   2
   3 use Moo;
   4 use Carp qw(croak);
   5
   6 #TODO sigh invoking a logger with a log level name the same
   7 #as an attribute could happen - restrict attributes to _ prefix
   8 #and restrict log levels to not start with out that prefix?
   9 has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } );
  10 has level_names => ( is => 'ro', required => 1 );
  11 has min_level => ( is => 'ro', required => 1, default => sub { 'info' } );
  12 has max_level => ( is => 'lazy', required => 1 );
  13 has _level_active => ( is => 'lazy' );
  14
  15 #just a stub so it doesn't get to AUTOLOAD
  16 sub BUILD { }
  17 sub DESTROY { }
  18
  19 sub AUTOLOAD {
  20   my $self = shift;
  21   (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);
  22
  23   no strict 'refs';
  24
  25   if ($method =~ m/^_/) {
  26     croak "invalid method name $method for " . ref($self);
  27   }
  28
  29   if ($method =~ m/^is_(.+)/) {
  30     my $level_name = $1;
  31     my $is_method = "is_$level_name";
  32     *{$is_method} = sub { shift(@_)->_level_active->{$level_name} };
  33     return $self->$is_method;
  34   }
  35
  36   my $level_name = $method;
  37   *{$level_name} = sub {
  38     my $self = shift;
  39     unless(exists($self->_level_active->{$level_name})) {
  40       croak "$level_name is not a valid log level name";
  41     }
  42
  43     $self->_log($level_name, @_);
  44   };
  45
  46   return $self->$level_name(@_);
  47 }
  48
  49 sub _build_max_level {
  50   my ($self) = @_;
  51   return $self->level_names->[-1];
  52 }
  53
  54 sub _build__level_active {
  55   my ($self) = @_;
  56   my $should_log = 0;
  57   my $min_level = $self->min_level;
  58   my $max_level = $self->max_level;
  59   my %active;
  60
  61   foreach my $level (@{$self->level_names}) {
  62     if($level eq $min_level) {
  63       $should_log = 1;
  64     }
  65
  66     $active{$level} = $should_log;
  67
  68     if (defined $max_level && $level eq $max_level) {
  69       $should_log = 0;
  70     }
  71   }
  72
  73   return \%active;
  74 }
  75
  76 sub _log {
  77   my ($self, $level, $content, $metadata_in) = @_;
  78   my %metadata = %$metadata_in;
  79   my $rendered = $self->_render($level, \%metadata, @$content);
  80   $self->_output($rendered);
  81 }
  82
  83 sub _create_format_lookup {
  84   my ($self, $level, $metadata, $content) = @_;
  85   my $method = $metadata->{method};
  86
  87   $method = '(none)' unless defined $method;
  88
  89   return {
  90     '%' => '%', 'n' => "\n",
  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->{exporter}, p => $metadata->{caller_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' unless defined $remote;
 115   my $conn_id = $remote->{connection_id};
 116   $conn_id = '(uninit)' unless defined $conn_id;
 117   return "remote #$conn_id";
 118 }
 119
 120 sub _render_log {
 121   my ($self, @content) = @_;
 122   return join('', @content);
 123 }
 124 sub _render {
 125   my ($self, $level, $metadata, @content) = @_;
 126   my $var_table = $self->_create_format_lookup($level, $metadata, [@content]);
 127   my $template = $self->format;
 128
 129   $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge;
 130
 131   chomp($template);
 132   $template =~ s/\n/\n /g;
 133   $template .= "\n";
 134   return $template;
 135 }
 136
 137 sub _output {
 138   my ($self, $content) = @_;
 139   print STDERR $content;
 140 }
 141
 142 1;
 143
 144 __END__
 145
 146 =head1 NAME
 147
 148 Object::Remote::Logging::Logger - Format and output a log message
 149
 150 =head1 SYNOPSIS
 151
 152   use Object::Remote::Logging::Logger;
 153   use Object::Remote::Logging qw( router arg_levels );
 154
 155   my $app_output = Object::Remote::Logging::Logger->new(
 156     level_names => arg_levels, format => '%t %s',
 157     min_level => 'verbose', max_level => 'info',
 158   );
 159
 160   #Selector method can return 0 or more logger
 161   #objects that will receive the messages
 162   my $selector = sub {
 163     my ($generating_package, $metadata) = @_;
 164     return unless $metadata->{exporter} eq 'App::Logging::Subclass';
 165     return $app_output;
 166   };
 167
 168   #true value as second argument causes the selector
 169   #to be stored with a weak reference
 170   router->connect($selector, 1);
 171
 172   #disconnect the selector from the router
 173   undef($selector);
 174
 175   #router will hold this logger forever
 176   #and send it all log messages
 177   router->connect(Object::Remote::Logging::Logger->new(
 178     level_names => arg_levels, format => '%s at %f line %i, log level: %l'
 179     min_level => 'warn', max_level => 'error',
 180   ));
 181
 182 =head1 DESCRIPTION
 183
 184 This class receives log messages from an instance of L<Object::Remote::Logging::Router>,
 185 formats them according to configuration, and then outputs them to STDERR. In between
 186 the router and the logger is a selector method which inspects the log message metadata
 187 and can return 0 or more loggers that should receive the log message.
 188
 189 =head1 USAGE
 190
 191 A logger object receives the log messages that are generated and converts them to
 192 formatted log entries then displays them to the end user. Each logger has a set
 193 of active log levels and will only output a log entry if the log message is at
 194 an active log level.
 195
 196 To gain access to the stream of log messages a connection is made to the log router.
 197 A logger can directly connect to the router and receive an unfiltered stream of
 198 log messages or a selector closure can be used instead. The selector will be executed
 199 for each log message with the message metadata and returns a list of 0 or more loggers
 200 that should receive the log message. When the selector is executed the first argument
 201 is the name of the package that generated the log message and the second argument
 202 is a hash reference containing the message metadata.
 203
 204 =head1 METADATA
 205
 206 The message metadata is a hash reference with the following keys:
 207
 208 =over 4
 209
 210 =item message_level
 211
 212 Name of the log level of the message.
 213
 214 =item exporter
 215
 216 Package name of the logging API that was used to generate the log message.
 217
 218 =item caller_package
 219
 220 Name of the package that generated the log message.
 221
 222 =item method
 223
 224 Name of the method the message was generated inside of.
 225
 226 =item timestamp
 227
 228 Unix time of the message generation.
 229
 230 =item pid
 231
 232 Process id of the Perl interpreter the message was generated in.
 233
 234 =item hostname
 235
 236 Hostname of the system where the message was generated.
 237
 238 =item filename
 239
 240 Name of the file the message was generated in.
 241
 242 =item line
 243
 244 Line of the source file the message was generated at.
 245
 246 =item object_remote
 247
 248 This is a reference to another hash that contains the Object::Remote
 249 specific information. The keys are
 250
 251 =over 4
 252
 253 =item connection_id
 254
 255 If the log message was generated on a remote Perl interpreter then the
 256 Object::Remote::Connection id of that interpreter will be available here.
 257
 258 =back
 259
 260 =back
 261
 262 =head1 ATTRIBUTES
 263
 264 =over 4
 265
 266 =item level_names
 267
 268 This is a required attribute. Must be an array ref with the list of log level names
 269 in it. The list must be ordered with the lowest level as element 0 and the highest
 270 level as the last element. There is no default value.
 271
 272 =item min_level
 273
 274 The lowest log level that will be output by the logger. There is no default value.
 275
 276 =item max_level
 277
 278 The highest log level that will be output by the logger. The default value is the
 279 highest level present in level_names.
 280
 281 =item format
 282
 283 The printf style format string to use when rendering the log message. The following
 284 sequences are significant:
 285
 286 =over 4
 287
 288 =item %l
 289
 290 Level name that the log message was generated at.
 291
 292 =item %s
 293
 294 Log message rendered into a string with a leading space before any additional lines in a
 295 multiple line message.
 296
 297 =item %t
 298
 299 Time the log message was generated rendered into a string. The time value is taken from
 300 the Perl interpreter that generated the log message; it is not the time that the logger
 301 received the log message on the local interpreter if the log message was forwarded.
 302
 303 =item %r
 304
 305 Object::Remote connection information rendered into a string.
 306
 307 =item %c
 308
 309 Package name of the logging API that was used to generate the log message.
 310
 311 =item %p
 312
 313 Name of the package 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 =item %n
 340
 341 A newline.
 342
 343 =back
 344
 345 =back
 346