lib/Log/Contextual.pm

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