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