lib/Log/Contextual.pm

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