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