lib/Log/Contextual.pm

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