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