lib/Log/Contextual.pm

   1 package Log::Contextual;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.004202';
   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 eval {
  16    require Log::Log4perl;
  17    die if $Log::Log4perl::VERSION < 1.29;
  18    Log::Log4perl->wrapper_register(__PACKAGE__)
  19 };
  20
  21 # ____ is because tags must have at least one export and we don't want to
  22 # export anything but the levels selected
  23 sub ____ { }
  24
  25 exports(qw(____ set_logger with_logger ));
  26
  27 export_tag dlog => ('____');
  28 export_tag log  => ('____');
  29 import_arguments qw(logger package_logger default_logger);
  30
  31 sub router {
  32    our $Router_Instance ||= do {
  33       require Log::Contextual::Router;
  34       Log::Contextual::Router->new
  35      }
  36 }
  37
  38 sub arg_logger         { $_[1] }
  39 sub arg_levels         { $_[1] || [qw(debug trace warn info error fatal)] }
  40 sub arg_package_logger { $_[1] }
  41 sub arg_default_logger { $_[1] }
  42
  43 sub before_import {
  44    my ($class, $importer, $spec) = @_;
  45    my $router      = $class->router;
  46    my $exports     = $spec->exports;
  47    my %router_args = (
  48       exporter  => $class,
  49       target    => $importer,
  50       arguments => $spec->argument_info
  51    );
  52
  53    die 'Log::Contextual does not have a default import list'
  54      if $spec->config->{default};
  55
  56    $router->before_import(%router_args);
  57
  58    if ($exports->{'&set_logger'}) {
  59       die ref($router) . " does not support set_logger()"
  60         unless $router->does('Log::Contextual::Role::Router::SetLogger');
  61
  62       $spec->add_export('&set_logger', sub { $router->set_logger(@_) })
  63    }
  64
  65    if ($exports->{'&with_logger'}) {
  66       die ref($router) . " does not support with_logger()"
  67         unless $router->does('Log::Contextual::Role::Router::WithLogger');
  68
  69       $spec->add_export('&with_logger', sub { $router->with_logger(@_) })
  70    }
  71
  72    my @levels = @{$class->arg_levels($spec->config->{levels})};
  73    for my $level (@levels) {
  74       if ($spec->config->{log}) {
  75          $spec->add_export(
  76             "&log_$level",
  77             sub (&@) {
  78                my ($code, @args) = @_;
  79                $router->handle_log_request(
  80                   exporter       => $class,
  81                   caller_package => scalar(caller),
  82                   caller_level   => 1,
  83                   message_level  => $level,
  84                   message_sub    => $code,
  85                   message_args   => \@args,
  86                );
  87                return @args;
  88             });
  89          $spec->add_export(
  90             "&logS_$level",
  91             sub (&@) {
  92                my ($code, @args) = @_;
  93                $router->handle_log_request(
  94                   exporter       => $class,
  95                   caller_package => scalar(caller),
  96                   caller_level   => 1,
  97                   message_level  => $level,
  98                   message_sub    => $code,
  99                   message_args   => \@args,
 100                );
 101                return $args[0];
 102             });
 103       }
 104       if ($spec->config->{dlog}) {
 105          $spec->add_export(
 106             "&Dlog_$level",
 107             sub (&@) {
 108                my ($code, @args) = @_;
 109                my $wrapped = sub {
 110                   local $_ = (@_ ? Data::Dumper::Concise::Dumper @_ : '()');
 111                   &$code;
 112                };
 113                $router->handle_log_request(
 114                   exporter       => $class,
 115                   caller_package => scalar(caller),
 116                   caller_level   => 1,
 117                   message_level  => $level,
 118                   message_sub    => $wrapped,
 119                   message_args   => \@args,
 120                );
 121                return @args;
 122             });
 123          $spec->add_export(
 124             "&DlogS_$level",
 125             sub (&$) {
 126                my ($code, $ref) = @_;
 127                my $wrapped = sub {
 128                   local $_ = Data::Dumper::Concise::Dumper($_[0]);
 129                   &$code;
 130                };
 131                $router->handle_log_request(
 132                   exporter       => $class,
 133                   caller_package => scalar(caller),
 134                   caller_level   => 1,
 135                   message_level  => $level,
 136                   message_sub    => $wrapped,
 137                   message_args   => [$ref],
 138                );
 139                return $ref;
 140             });
 141       }
 142    }
 143 }
 144
 145 sub after_import {
 146    my ($class, $importer, $spec) = @_;
 147    my %router_args = (
 148       exporter  => $class,
 149       target    => $importer,
 150       arguments => $spec->argument_info
 151    );
 152    $class->router->after_import(%router_args);
 153 }
 154
 155 1;
 156
 157 __END__
 158
 159 =head1 NAME
 160
 161 Log::Contextual - Simple logging interface with a contextual log
 162
 163 =head1 SYNOPSIS
 164
 165  use Log::Contextual qw( :log :dlog set_logger with_logger );
 166  use Log::Contextual::SimpleLogger;
 167  use Log::Log4perl ':easy';
 168  Log::Log4perl->easy_init($DEBUG);
 169
 170  my $logger  = Log::Log4perl->get_logger;
 171
 172  set_logger $logger;
 173
 174  log_debug { 'program started' };
 175
 176  sub foo {
 177
 178    my $minilogger = Log::Contextual::SimpleLogger->new({
 179      levels => [qw( trace debug )]
 180    });
 181
 182    with_logger $minilogger => sub {
 183      log_trace { 'foo entered' };
 184      my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
 185      # ...
 186      log_trace { 'foo left' };
 187    };
 188  }
 189
 190  foo();
 191
 192 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
 193 with C<Log::Contextual>:
 194
 195  use Log::Contextual qw( :log :dlog set_logger );
 196  use Log::Dispatchouli;
 197  my $ld = Log::Dispatchouli->new({
 198     ident     => 'slrtbrfst',
 199     to_stderr => 1,
 200     debug     => 1,
 201  });
 202
 203  set_logger $ld;
 204
 205  log_debug { 'program started' };
 206
 207 =head1 DESCRIPTION
 208
 209 Major benefits:
 210
 211 =over 2
 212
 213 =item * Efficient
 214
 215 The logging functions take blocks, so if a log level is disabled, the
 216 block will not run:
 217
 218  # the following won't run if debug is off
 219  log_debug { "the new count in the database is " . $rs->count };
 220
 221 Similarly, the C<D> prefixed methods only C<Dumper> the input if the level is
 222 enabled.
 223
 224 =item * Handy
 225
 226 The logging functions return their arguments, so you can stick them in
 227 the middle of expressions:
 228
 229  for (log_debug { "downloading:\n" . join qq(\n), @_ } @urls) { ... }
 230
 231 =item * Generic
 232
 233 C<Log::Contextual> is an interface for all major loggers.  If you log through
 234 C<Log::Contextual> you will be able to swap underlying loggers later.
 235
 236 =item * Powerful
 237
 238 C<Log::Contextual> chooses which logger to use based on L<< user defined C<CodeRef>s|/LOGGER CODEREF >>.
 239 Normally you don't need to know this, but you can take advantage of it when you
 240 need to later
 241
 242 =item * Scalable
 243
 244 If you just want to add logging to your extremely basic application, start with
 245 L<Log::Contextual::SimpleLogger> and then as your needs grow you can switch to
 246 L<Log::Dispatchouli> or L<Log::Dispatch> or L<Log::Log4perl> or whatever else.
 247
 248 =back
 249
 250 This module is a simple interface to extensible logging.  It exists to
 251 abstract your logging interface so that logging is as painless as possible,
 252 while still allowing you to switch from one logger to another.
 253
 254 It is bundled with a really basic logger, L<Log::Contextual::SimpleLogger>,
 255 but in general you should use a real logger instead of that.  For something
 256 more serious but not overly complicated, try L<Log::Dispatchouli> (see
 257 L</SYNOPSIS> for example.)
 258
 259 =head1 A WORK IN PROGRESS
 260
 261 This module is certainly not complete, but we will not break the interface
 262 lightly, so I would say it's safe to use in production code.  The main result
 263 from that at this point is that doing:
 264
 265  use Log::Contextual;
 266
 267 will die as we do not yet know what the defaults should be.  If it turns out
 268 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
 269 probably make C<:log> the default.  But only time and usage will tell.
 270
 271 =head1 IMPORT OPTIONS
 272
 273 See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
 274 wide.
 275
 276 =head2 -logger
 277
 278 When you import this module you may use C<-logger> as a shortcut for
 279 L<set_logger>, for example:
 280
 281  use Log::Contextual::SimpleLogger;
 282  use Log::Contextual qw( :dlog ),
 283    -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
 284
 285 sometimes you might want to have the logger handy for other stuff, in which
 286 case you might try something like the following:
 287
 288  my $var_log;
 289  BEGIN { $var_log = VarLogger->new }
 290  use Log::Contextual qw( :dlog ), -logger => $var_log;
 291
 292 =head2 -levels
 293
 294 The C<-levels> import option allows you to define exactly which levels your
 295 logger supports.  So the default,
 296 C<< [qw(debug trace warn info error fatal)] >>, works great for
 297 L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>.  But
 298 supporting those levels is as easy as doing
 299
 300  use Log::Contextual
 301    -levels => [qw( debug info notice warning error critical alert emergency )];
 302
 303 =head2 -package_logger
 304
 305 The C<-package_logger> import option is similar to the C<-logger> import option
 306 except C<-package_logger> sets the the logger for the current package.
 307
 308 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
 309 L</set_logger>.
 310
 311  package My::Package;
 312  use Log::Contextual::SimpleLogger;
 313  use Log::Contextual qw( :log ),
 314    -package_logger => Log::Contextual::WarnLogger->new({
 315       env_prefix => 'MY_PACKAGE'
 316    });
 317
 318 If you are interested in using this package for a module you are putting on
 319 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
 320
 321 =head2 -default_logger
 322
 323 The C<-default_logger> import option is similar to the C<-logger> import option
 324 except C<-default_logger> sets the the B<default> logger for the current package.
 325
 326 Basically it sets the logger to be used if C<set_logger> is never called; so
 327
 328  package My::Package;
 329  use Log::Contextual::SimpleLogger;
 330  use Log::Contextual qw( :log ),
 331    -default_logger => Log::Contextual::WarnLogger->new({
 332       env_prefix => 'MY_PACKAGE'
 333    });
 334
 335 =head1 SETTING DEFAULT IMPORT OPTIONS
 336
 337 Eventually you will get tired of writing the following in every single one of
 338 your packages:
 339
 340  use Log::Log4perl;
 341  use Log::Log4perl ':easy';
 342  BEGIN { Log::Log4perl->easy_init($DEBUG) }
 343
 344  use Log::Contextual -logger => Log::Log4perl->get_logger;
 345
 346 You can set any of the import options for your whole project if you define your
 347 own C<Log::Contextual> subclass as follows:
 348
 349  package MyApp::Log::Contextual;
 350
 351  use base 'Log::Contextual';
 352
 353  use Log::Log4perl ':easy';
 354  Log::Log4perl->easy_init($DEBUG)
 355
 356  sub arg_default_logger { $_[1] || Log::Log4perl->get_logger }
 357  sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
 358
 359  # or maybe instead of default_logger
 360  sub arg_package_logger { $_[1] }
 361
 362  # and almost definitely not this, which is only here for completeness
 363  sub arg_logger { $_[1] }
 364
 365 Note the C<< $_[1] || >> in C<arg_default_logger>.  All of these methods are
 366 passed the values passed in from the arguments to the subclass, so you can
 367 either throw them away, honor them, die on usage, or whatever.  To be clear,
 368 if you define your subclass, and someone uses it as follows:
 369
 370  use MyApp::Log::Contextual -default_logger => $foo,
 371                             -levels => [qw(bar baz biff)];
 372
 373 Your C<arg_default_logger> method will get C<$foo> and your C<arg_levels>
 374 will get C<[qw(bar baz biff)]>;
 375
 376 =head1 FUNCTIONS
 377
 378 =head2 set_logger
 379
 380  my $logger = WarnLogger->new;
 381  set_logger $logger;
 382
 383 Arguments: L</LOGGER CODEREF>
 384
 385 C<set_logger> will just set the current logger to whatever you pass it.  It
 386 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
 387 C<CodeRef> for you.  C<set_logger> is really meant only to be called from a
 388 top-level script.  To avoid foot-shooting the function will warn if you call it
 389 more than once.
 390
 391 =head2 with_logger
 392
 393  my $logger = WarnLogger->new;
 394  with_logger $logger => sub {
 395     if (1 == 0) {
 396        log_fatal { 'Non Logical Universe Detected' };
 397     } else {
 398        log_info  { 'All is good' };
 399     }
 400  };
 401
 402 Arguments: L</LOGGER CODEREF>, C<CodeRef $to_execute>
 403
 404 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
 405 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
 406 C<CodeRef> if needed.
 407
 408 =head2 log_$level
 409
 410 Import Tag: C<:log>
 411
 412 Arguments: C<CodeRef $returning_message, @args>
 413
 414 C<log_$level> functions all work the same except that a different method
 415 is called on the underlying C<$logger> object.  The basic pattern is:
 416
 417  sub log_$level (&@) {
 418    if ($logger->is_$level) {
 419      $logger->$level(shift->(@_));
 420    }
 421    @_
 422  }
 423
 424 Note that the function returns it's arguments.  This can be used in a number of
 425 ways, but often it's convenient just for partial inspection of passthrough data
 426
 427  my @friends = log_trace {
 428    'friends list being generated, data from first friend: ' .
 429      Dumper($_[0]->TO_JSON)
 430  } generate_friend_list();
 431
 432 If you want complete inspection of passthrough data, take a look at the
 433 L</Dlog_$level> functions.
 434
 435 Which functions are exported depends on what was passed to L</-levels>.  The
 436 default (no C<-levels> option passed) would export:
 437
 438 =over 2
 439
 440 =item log_trace
 441
 442 =item log_debug
 443
 444 =item log_info
 445
 446 =item log_warn
 447
 448 =item log_error
 449
 450 =item log_fatal
 451
 452 =back
 453
 454 =head2 logS_$level
 455
 456 Import Tag: C<:log>
 457
 458 Arguments: C<CodeRef $returning_message, Item $arg>
 459
 460 This is really just a special case of the L</log_$level> functions.  It forces
 461 scalar context when that is what you need.  Other than that it works exactly
 462 same:
 463
 464  my $friend = logS_trace {
 465    'I only have one friend: ' .  Dumper($_[0]->TO_JSON)
 466  } friend();
 467
 468 See also: L</DlogS_$level>.
 469
 470 =head2 Dlog_$level
 471
 472 Import Tag: C<:dlog>
 473
 474 Arguments: C<CodeRef $returning_message, @args>
 475
 476 All of the following six functions work the same as their L</log_$level>
 477 brethren, except they return what is passed into them and put the stringified
 478 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 479 you can do cool things like the following:
 480
 481  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 482
 483 and the output might look something like:
 484
 485  names: "fREW"
 486  "fRIOUX"
 487  "fROOH"
 488  "fRUE"
 489  "fiSMBoC"
 490
 491 Which functions are exported depends on what was passed to L</-levels>.  The
 492 default (no C<-levels> option passed) would export:
 493
 494 =over 2
 495
 496 =item Dlog_trace
 497
 498 =item Dlog_debug
 499
 500 =item Dlog_info
 501
 502 =item Dlog_warn
 503
 504 =item Dlog_error
 505
 506 =item Dlog_fatal
 507
 508 =back
 509
 510 =head2 DlogS_$level
 511
 512 Import Tag: C<:dlog>
 513
 514 Arguments: C<CodeRef $returning_message, Item $arg>
 515
 516 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
 517 They only take a single scalar after the C<$returning_message> instead of
 518 slurping up (and also setting C<wantarray>) all the C<@args>
 519
 520  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 521    $schema->resultset('Pals')->search({ perlers => 1 });
 522
 523 =head1 LOGGER CODEREF
 524
 525 Anywhere a logger object can be passed, a coderef is accepted.  This is so
 526 that the user can use different logger objects based on runtime information.
 527 The logger coderef is passed the package of the caller the caller level the
 528 coderef needs to use if it wants more caller information.  The latter is in
 529 a hashref to allow for more options in the future.
 530
 531 Here is a basic example of a logger that exploits C<caller> to reproduce the
 532 output of C<warn> with a logger:
 533
 534  my @caller_info;
 535  my $var_log = Log::Contextual::SimpleLogger->new({
 536     levels  => [qw(trace debug info warn error fatal)],
 537     coderef => sub { chomp($_[0]); warn "$_[0] at $caller_info[1] line $caller_info[2].\n" }
 538  });
 539  my $warn_faker = sub {
 540     my ($package, $args) = @_;
 541     @caller_info = caller($args->{caller_level});
 542     $var_log
 543  };
 544  set_logger($warn_faker);
 545  log_debug { 'test' };
 546
 547 The following is an example that uses the information passed to the logger
 548 coderef.  It sets the global logger to C<$l3>, the logger for the C<A1>
 549 package to C<$l1>, except the C<lol> method in C<A1> which uses the C<$l2>
 550 logger and lastly the logger for the C<A2> package to C<$l2>.
 551
 552 Note that it increases the caller level as it dispatches based on where
 553 the caller of the log function, not the log function itself.
 554
 555  my $complex_dispatcher = do {
 556
 557     my $l1 = ...;
 558     my $l2 = ...;
 559     my $l3 = ...;
 560
 561     my %registry = (
 562        -logger => $l3,
 563        A1 => {
 564           -logger => $l1,
 565           lol     => $l2,
 566        },
 567        A2 => { -logger => $l2 },
 568     );
 569
 570     sub {
 571        my ( $package, $info ) = @_;
 572
 573        my $logger = $registry{'-logger'};
 574        if (my $r = $registry{$package}) {
 575           $logger = $r->{'-logger'} if $r->{'-logger'};
 576           my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1);
 577           $sub =~ s/^\Q$package\E:://g;
 578           $logger = $r->{$sub} if $r->{$sub};
 579        }
 580        return $logger;
 581     }
 582  };
 583
 584  set_logger $complex_dispatcher;
 585
 586 =head1 LOGGER INTERFACE
 587
 588 Because this module is ultimately pretty looking glue (glittery?) with the
 589 awesome benefit of the Contextual part, users will often want to make their
 590 favorite logger work with it.  The following are the methods that should be
 591 implemented in the logger:
 592
 593  is_trace
 594  is_debug
 595  is_info
 596  is_warn
 597  is_error
 598  is_fatal
 599  trace
 600  debug
 601  info
 602  warn
 603  error
 604  fatal
 605
 606 The first six merely need to return true if that level is enabled.  The latter
 607 six take the results of whatever the user returned from their coderef and log
 608 them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 609
 610 =head1 LOG ROUTING
 611
 612 In between the loggers and the log functions is a log router that is responsible for
 613 finding a logger to handle the log event and passing the log information to the
 614 logger. This relationship is described in the documentation for C<Log::Contextual::Role::Router>.
 615
 616 C<Log::Contextual> and packages that extend it will by default share a router singleton that
 617 implements the with_logger() and set_logger() functions and also respects the -logger,
 618 -package_logger, and -default_logger import options with their associated default value
 619 functions. The router singleton is available as the return value of the router() function. Users
 620 of Log::Contextual may overload router() to return instances of custom log routers that
 621 could for example work with loggers that use a different interface.
 622
 623 =head1 AUTHOR
 624
 625 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 626
 627 =head1 CONTRIBUTORS
 628
 629 triddle - Tyler Riddle <t.riddle@shadowcat.co.uk>
 630
 631 =head1 DESIGNER
 632
 633 mst - Matt S. Trout <mst@shadowcat.co.uk>
 634
 635 =head1 COPYRIGHT
 636
 637 Copyright (c) 2012 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 638 above.
 639
 640 =head1 LICENSE
 641
 642 This library is free software and may be distributed under the same terms as
 643 Perl 5 itself.
 644
 645 =cut
 646