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