lib/Log/Contextual.pm

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