lib/Log/Contextual.pm

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