lib/Log/Contextual.pm

   1 package Log::Contextual;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.00305';
   7
   8 my @levels = qw(debug trace warn info error fatal);
   9
  10 use Exporter::Declare;
  11 use Exporter::Declare::Export::Generator;
  12 use Data::Dumper::Concise;
  13 use Scalar::Util 'blessed';
  14
  15 my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
  16
  17 my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
  18
  19 eval {
  20    require Log::Log4perl;
  21    die if $Log::Log4perl::VERSION < 1.29;
  22    Log::Log4perl->wrapper_register(__PACKAGE__)
  23 };
  24
  25 # ____ is because tags must have at least one export and we don't want to
  26 # export anything but the levels selected
  27 sub ____ {}
  28
  29 exports ('____',
  30    @dlog, @log,
  31    qw( set_logger with_logger )
  32 );
  33
  34 export_tag dlog => ('____');
  35 export_tag log  => ('____');
  36 import_arguments qw(logger package_logger default_logger);
  37
  38 sub before_import {
  39    my ($class, $importer, $spec) = @_;
  40
  41    die 'Log::Contextual does not have a default import list'
  42       if $spec->config->{default};
  43
  44    my @levels = @{$class->arg_levels($spec->config->{levels})};
  45    for my $level (@levels) {
  46       if ($spec->config->{log}) {
  47          $spec->add_export("&log_$level", sub (&@) {
  48             _do_log( $level => _get_logger( caller ), shift @_, @_)
  49          });
  50          $spec->add_export("&logS_$level", sub (&@) {
  51             _do_logS( $level => _get_logger( caller ), $_[0], $_[1])
  52          });
  53       }
  54       if ($spec->config->{dlog}) {
  55          $spec->add_export("&Dlog_$level", sub (&@) {
  56            my ($code, @args) = @_;
  57            return _do_log( $level => _get_logger( caller ), sub {
  58               local $_ = (@args?Data::Dumper::Concise::Dumper @args:'()');
  59               $code->(@_)
  60            }, @args );
  61          });
  62          $spec->add_export("&DlogS_$level", sub (&$) {
  63            my ($code, $ref) = @_;
  64            _do_logS( $level => _get_logger( caller ), sub {
  65               local $_ = Data::Dumper::Concise::Dumper $ref;
  66               $code->($ref)
  67            }, $ref )
  68          });
  69       }
  70    }
  71 }
  72
  73 sub arg_logger { $_[1] }
  74 sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
  75 sub arg_package_logger { $_[1] }
  76 sub arg_default_logger { $_[1] }
  77
  78 sub after_import {
  79    my ($class, $importer, $specs) = @_;
  80
  81    if (my $l = $class->arg_logger($specs->config->{logger})) {
  82       set_logger($l)
  83    }
  84
  85    if (my $l = $class->arg_package_logger($specs->config->{package_logger})) {
  86       _set_package_logger_for($importer, $l)
  87    }
  88
  89    if (my $l = $class->arg_default_logger($specs->config->{default_logger})) {
  90       _set_default_logger_for($importer, $l)
  91    }
  92 }
  93
  94 our $Get_Logger;
  95 our %Default_Logger;
  96 our %Package_Logger;
  97
  98 sub _set_default_logger_for {
  99    my $logger = $_[1];
 100    if(ref $logger ne 'CODE') {
 101       die 'logger was not a CodeRef or a logger object.  Please try again.'
 102          unless blessed($logger);
 103       $logger = do { my $l = $logger; sub { $l } }
 104    }
 105    $Default_Logger{$_[0]} = $logger
 106 }
 107
 108 sub _set_package_logger_for {
 109    my $logger = $_[1];
 110    if(ref $logger ne 'CODE') {
 111       die 'logger was not a CodeRef or a logger object.  Please try again.'
 112          unless blessed($logger);
 113       $logger = do { my $l = $logger; sub { $l } }
 114    }
 115    $Package_Logger{$_[0]} = $logger
 116 }
 117
 118 sub _get_logger($) {
 119    my $package = shift;
 120    (
 121       $Package_Logger{$package} ||
 122       $Get_Logger ||
 123       $Default_Logger{$package} ||
 124       die q( no logger set!  you can't try to log something without a logger! )
 125    )->($package);
 126 }
 127
 128 sub set_logger {
 129    my $logger = $_[0];
 130    if(ref $logger ne 'CODE') {
 131       die 'logger was not a CodeRef or a logger object.  Please try again.'
 132          unless blessed($logger);
 133       $logger = do { my $l = $logger; sub { $l } }
 134    }
 135
 136    warn 'set_logger (or -logger) called more than once!  This is a bad idea!'
 137       if $Get_Logger;
 138    $Get_Logger = $logger;
 139 }
 140
 141 sub with_logger {
 142    my $logger = $_[0];
 143    if(ref $logger ne 'CODE') {
 144       die 'logger was not a CodeRef or a logger object.  Please try again.'
 145          unless blessed($logger);
 146       $logger = do { my $l = $logger; sub { $l } }
 147    }
 148    local $Get_Logger = $logger;
 149    $_[1]->();
 150 }
 151
 152 sub _do_log {
 153    my $level  = shift;
 154    my $logger = shift;
 155    my $code   = shift;
 156    my @values = @_;
 157
 158    $logger->$level($code->(@_))
 159       if $logger->${\"is_$level"};
 160    @values
 161 }
 162
 163 sub _do_logS {
 164    my $level  = shift;
 165    my $logger = shift;
 166    my $code   = shift;
 167    my $value  = shift;
 168
 169    $logger->$level($code->($value))
 170       if $logger->${\"is_$level"};
 171    $value
 172 }
 173
 174 1;
 175
 176 __END__
 177
 178 =head1 NAME
 179
 180 Log::Contextual - Simple logging interface with a contextual log
 181
 182 =head1 SYNOPSIS
 183
 184  use Log::Contextual qw( :log :dlog set_logger with_logger );
 185  use Log::Contextual::SimpleLogger;
 186  use Log::Log4perl ':easy';
 187  Log::Log4perl->easy_init($DEBUG);
 188
 189
 190  my $logger  = Log::Log4perl->get_logger;
 191
 192  set_logger $logger;
 193
 194  log_debug { 'program started' };
 195
 196  sub foo {
 197    with_logger(Log::Contextual::SimpleLogger->new({
 198        levels => [qw( trace debug )]
 199      }) => sub {
 200      log_trace { 'foo entered' };
 201      my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
 202      # ...
 203      log_trace { 'foo left' };
 204    });
 205  }
 206
 207  foo();
 208
 209 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
 210 with C<Log::Contextual>:
 211
 212  use Log::Contextual qw( :log :dlog set_logger );
 213  use Log::Dispatchouli;
 214  my $ld = Log::Dispatchouli->new({
 215     ident     => 'slrtbrfst',
 216     to_stderr => 1,
 217     debug     => 1,
 218  });
 219
 220  set_logger $ld;
 221
 222  log_debug { 'program started' };
 223
 224 =head1 DESCRIPTION
 225
 226 This module is a simple interface to extensible logging.  It is bundled with a
 227 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
 228 should use a real logger instead of that.  For something more serious but not
 229 overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
 230
 231 The reason for this module is to abstract your logging interface so that
 232 logging is as painless as possible, while still allowing you to switch from one
 233 logger to another.
 234
 235 =head1 OPTIONS
 236
 237 =head2 -logger
 238
 239 When you import this module you may use C<-logger> as a shortcut for
 240 L<set_logger>, for example:
 241
 242  use Log::Contextual::SimpleLogger;
 243  use Log::Contextual qw( :dlog ),
 244    -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
 245
 246 sometimes you might want to have the logger handy for other stuff, in which
 247 case you might try something like the following:
 248
 249  my $var_log;
 250  BEGIN { $var_log = VarLogger->new }
 251  use Log::Contextual qw( :dlog ), -logger => $var_log;
 252
 253 =head2 -levels
 254
 255 The C<-levels> import option allows you to define exactly which levels your
 256 logger supports.  So the default,
 257 C<< [qw(debug trace warn info error fatal)] >>, works great for
 258 L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>.  But
 259 supporting those levels is as easy as doing
 260
 261  use Log::Contextual
 262    -levels => [qw( debug info notice warning error critical alert emergency )];
 263
 264 =head2 -package_logger
 265
 266 The C<-package_logger> import option is similar to the C<-logger> import option
 267 except C<-package_logger> sets the the logger for the current package.
 268
 269 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
 270 L</set_logger>.
 271
 272  package My::Package;
 273  use Log::Contextual::SimpleLogger;
 274  use Log::Contextual qw( :log ),
 275    -package_logger => Log::Contextual::WarnLogger->new({
 276       env_prefix => 'MY_PACKAGE'
 277    });
 278
 279 If you are interested in using this package for a module you are putting on
 280 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
 281
 282 =head2 -default_logger
 283
 284 The C<-default_logger> import option is similar to the C<-logger> import option
 285 except C<-default_logger> sets the the B<default> logger for the current package.
 286
 287 Basically it sets the logger to be used if C<set_logger> is never called; so
 288
 289  package My::Package;
 290  use Log::Contextual::SimpleLogger;
 291  use Log::Contextual qw( :log ),
 292    -default_logger => Log::Contextual::WarnLogger->new({
 293       env_prefix => 'MY_PACKAGE'
 294    });
 295
 296 =head1 A WORK IN PROGRESS
 297
 298 This module is certainly not complete, but we will not break the interface
 299 lightly, so I would say it's safe to use in production code.  The main result
 300 from that at this point is that doing:
 301
 302  use Log::Contextual;
 303
 304 will die as we do not yet know what the defaults should be.  If it turns out
 305 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
 306 probably make C<:log> the default.  But only time and usage will tell.
 307
 308 =head1 FUNCTIONS
 309
 310 =head2 set_logger
 311
 312  my $logger = WarnLogger->new;
 313  set_logger $logger;
 314
 315 Arguments: C<Ref|CodeRef $returning_logger>
 316
 317 C<set_logger> will just set the current logger to whatever you pass it.  It
 318 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
 319 C<CodeRef> for you.  C<set_logger> is really meant only to be called from a
 320 top-level script.  To avoid foot-shooting the function will warn if you call it
 321 more than once.
 322
 323 =head2 with_logger
 324
 325  my $logger = WarnLogger->new;
 326  with_logger $logger => sub {
 327     if (1 == 0) {
 328        log_fatal { 'Non Logical Universe Detected' };
 329     } else {
 330        log_info  { 'All is good' };
 331     }
 332  };
 333
 334 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
 335
 336 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
 337 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
 338 C<CodeRef> if needed.
 339
 340 =head2 log_$level
 341
 342 Import Tag: C<:log>
 343
 344 Arguments: C<CodeRef $returning_message, @args>
 345
 346 All of the following six functions work the same except that a different method
 347 is called on the underlying C<$logger> object.  The basic pattern is:
 348
 349  sub log_$level (&@) {
 350    if ($logger->is_$level) {
 351      $logger->$level(shift->(@_));
 352    }
 353    @_
 354  }
 355
 356 Note that the function returns it's arguments.  This can be used in a number of
 357 ways, but often it's convenient just for partial inspection of passthrough data
 358
 359  my @friends = log_trace {
 360    'friends list being generated, data from first friend: ' .
 361      Dumper($_[0]->TO_JSON)
 362  } generate_friend_list();
 363
 364 If you want complete inspection of passthrough data, take a look at the
 365 L</Dlog_$level> functions.
 366
 367 =head3 log_trace
 368
 369  log_trace { 'entered method foo with args ' join q{,}, @args };
 370
 371 =head3 log_debug
 372
 373  log_debug { 'entered method foo' };
 374
 375 =head3 log_info
 376
 377  log_info { 'started process foo' };
 378
 379 =head3 log_warn
 380
 381  log_warn { 'possible misconfiguration at line 10' };
 382
 383 =head3 log_error
 384
 385  log_error { 'non-numeric user input!' };
 386
 387 =head3 log_fatal
 388
 389  log_fatal { '1 is never equal to 0!' };
 390
 391 =head2 logS_$level
 392
 393 Import Tag: C<:log>
 394
 395 Arguments: C<CodeRef $returning_message, Item $arg>
 396
 397 This is really just a special case of the L</log_$level> functions.  It forces
 398 scalar context when that is what you need.  Other than that it works exactly
 399 same:
 400
 401  my $friend = logS_trace {
 402    'I only have one friend: ' .  Dumper($_[0]->TO_JSON)
 403  } friend();
 404
 405 See also: L</DlogS_$level>.
 406
 407 =head2 Dlog_$level
 408
 409 Import Tag: C<:dlog>
 410
 411 Arguments: C<CodeRef $returning_message, @args>
 412
 413 All of the following six functions work the same as their L</log_$level>
 414 brethren, except they return what is passed into them and put the stringified
 415 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 416 you can do cool things like the following:
 417
 418  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 419
 420 and the output might look something like:
 421
 422  names: "fREW"
 423  "fRIOUX"
 424  "fROOH"
 425  "fRUE"
 426  "fiSMBoC"
 427
 428 =head3 Dlog_trace
 429
 430  my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
 431
 432 =head3 Dlog_debug
 433
 434  Dlog_debug { "random data structure: $_" } { foo => $bar };
 435
 436 =head3 Dlog_info
 437
 438  return Dlog_info { "html from method returned: $_" } "<html>...</html>";
 439
 440 =head3 Dlog_warn
 441
 442  Dlog_warn { "probably invalid value: $_" } $foo;
 443
 444 =head3 Dlog_error
 445
 446  Dlog_error { "non-numeric user input! ($_)" } $port;
 447
 448 =head3 Dlog_fatal
 449
 450  Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 451
 452 =head2 DlogS_$level
 453
 454 Import Tag: C<:dlog>
 455
 456 Arguments: C<CodeRef $returning_message, Item $arg>
 457
 458 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
 459 They only take a single scalar after the C<$returning_message> instead of
 460 slurping up (and also setting C<wantarray>) all the C<@args>
 461
 462  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 463    $schema->resultset('Pals')->search({ perlers => 1 });
 464
 465 =head1 LOGGER INTERFACE
 466
 467 Because this module is ultimately pretty looking glue (glittery?) with the
 468 awesome benefit of the Contextual part, users will often want to make their
 469 favorite logger work with it.  The following are the methods that should be
 470 implemented in the logger:
 471
 472  is_trace
 473  is_debug
 474  is_info
 475  is_warn
 476  is_error
 477  is_fatal
 478  trace
 479  debug
 480  info
 481  warn
 482  error
 483  fatal
 484
 485 The first six merely need to return true if that level is enabled.  The latter
 486 six take the results of whatever the user returned from their coderef and log
 487 them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 488
 489 =head1 AUTHOR
 490
 491 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 492
 493 =head1 DESIGNER
 494
 495 mst - Matt S. Trout <mst@shadowcat.co.uk>
 496
 497 =head1 COPYRIGHT
 498
 499 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 500 above.
 501
 502 =head1 LICENSE
 503
 504 This library is free software and may be distributed under the same terms as
 505 Perl 5 itself.
 506
 507 =cut
 508