lib/Log/Contextual.pm

   1 package Log::Contextual;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.004100';
   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);
 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
 190  my $logger  = Log::Log4perl->get_logger;
 191
 192  set_logger $logger;
 193
 194  log_debug { 'program started' };
 195
 196  sub foo {
 197
 198    my $minilogger = Log::Contextual::SimpleLogger->new({
 199      levels => [qw( trace debug )]
 200    });
 201
 202    with_logger $minilogger => sub {
 203      log_trace { 'foo entered' };
 204      my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
 205      # ...
 206      log_trace { 'foo left' };
 207    };
 208  }
 209
 210  foo();
 211
 212 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
 213 with C<Log::Contextual>:
 214
 215  use Log::Contextual qw( :log :dlog set_logger );
 216  use Log::Dispatchouli;
 217  my $ld = Log::Dispatchouli->new({
 218     ident     => 'slrtbrfst',
 219     to_stderr => 1,
 220     debug     => 1,
 221  });
 222
 223  set_logger $ld;
 224
 225  log_debug { 'program started' };
 226
 227 =head1 DESCRIPTION
 228
 229 This module is a simple interface to extensible logging.  It is bundled with a
 230 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
 231 should use a real logger instead of that.  For something more serious but not
 232 overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
 233
 234 The reason for this module is to abstract your logging interface so that
 235 logging is as painless as possible, while still allowing you to switch from one
 236 logger to another.
 237
 238 =head1 A WORK IN PROGRESS
 239
 240 This module is certainly not complete, but we will not break the interface
 241 lightly, so I would say it's safe to use in production code.  The main result
 242 from that at this point is that doing:
 243
 244  use Log::Contextual;
 245
 246 will die as we do not yet know what the defaults should be.  If it turns out
 247 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
 248 probably make C<:log> the default.  But only time and usage will tell.
 249
 250 =head1 IMPORT OPTIONS
 251
 252 See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
 253 wide.
 254
 255 =head2 -logger
 256
 257 When you import this module you may use C<-logger> as a shortcut for
 258 L<set_logger>, for example:
 259
 260  use Log::Contextual::SimpleLogger;
 261  use Log::Contextual qw( :dlog ),
 262    -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
 263
 264 sometimes you might want to have the logger handy for other stuff, in which
 265 case you might try something like the following:
 266
 267  my $var_log;
 268  BEGIN { $var_log = VarLogger->new }
 269  use Log::Contextual qw( :dlog ), -logger => $var_log;
 270
 271 =head2 -levels
 272
 273 The C<-levels> import option allows you to define exactly which levels your
 274 logger supports.  So the default,
 275 C<< [qw(debug trace warn info error fatal)] >>, works great for
 276 L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>.  But
 277 supporting those levels is as easy as doing
 278
 279  use Log::Contextual
 280    -levels => [qw( debug info notice warning error critical alert emergency )];
 281
 282 =head2 -package_logger
 283
 284 The C<-package_logger> import option is similar to the C<-logger> import option
 285 except C<-package_logger> sets the the logger for the current package.
 286
 287 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
 288 L</set_logger>.
 289
 290  package My::Package;
 291  use Log::Contextual::SimpleLogger;
 292  use Log::Contextual qw( :log ),
 293    -package_logger => Log::Contextual::WarnLogger->new({
 294       env_prefix => 'MY_PACKAGE'
 295    });
 296
 297 If you are interested in using this package for a module you are putting on
 298 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
 299
 300 =head2 -default_logger
 301
 302 The C<-default_logger> import option is similar to the C<-logger> import option
 303 except C<-default_logger> sets the the B<default> logger for the current package.
 304
 305 Basically it sets the logger to be used if C<set_logger> is never called; so
 306
 307  package My::Package;
 308  use Log::Contextual::SimpleLogger;
 309  use Log::Contextual qw( :log ),
 310    -default_logger => Log::Contextual::WarnLogger->new({
 311       env_prefix => 'MY_PACKAGE'
 312    });
 313
 314 =head1 SETTING DEFAULT IMPORT OPTIONS
 315
 316 Eventually you will get tired of writing the following in every single one of
 317 your packages:
 318
 319  use Log::Log4perl;
 320  use Log::Log4perl ':easy';
 321  BEGIN { Log::Log4perl->easy_init($DEBUG) }
 322
 323  use Log::Contextual -logger => Log::Log4perl->get_logger;
 324
 325 You can set any of the import options for your whole project if you define your
 326 own C<Log::Contextual> subclass as follows:
 327
 328  package MyApp::Log::Contextual;
 329
 330  use base 'Log::Contextual';
 331
 332  use Log::Log4perl ':easy';
 333  Log::Log4perl->easy_init($DEBUG)
 334
 335  sub arg_default_logger { $_[1] || Log::Log4perl->get_logger }
 336  sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
 337
 338  # or maybe instead of default_logger
 339  sub arg_package_logger { $_[1] }
 340
 341  # and almost definitely not this, which is only here for completeness
 342  sub arg_logger { $_[1] }
 343
 344 Note the C<< $_[1] || >> in C<arg_default_logger>.  All of these methods are
 345 passed the values passed in from the arguments to the subclass, so you can
 346 either throw them away, honor them, die on usage, or whatever.  To be clear,
 347 if you define your subclass, and someone uses it as follows:
 348
 349  use MyApp::Log::Contextual -default_logger => $foo,
 350                             -levels => [qw(bar baz biff)];
 351
 352 Your C<arg_default_logger> method will get C<$foo> and your C<arg_levels>
 353 will get C<[qw(bar baz biff)]>;
 354
 355 =head1 FUNCTIONS
 356
 357 =head2 set_logger
 358
 359  my $logger = WarnLogger->new;
 360  set_logger $logger;
 361
 362 Arguments: C<Ref|CodeRef $returning_logger>
 363
 364 C<set_logger> will just set the current logger to whatever you pass it.  It
 365 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
 366 C<CodeRef> for you.  C<set_logger> is really meant only to be called from a
 367 top-level script.  To avoid foot-shooting the function will warn if you call it
 368 more than once.
 369
 370 =head2 with_logger
 371
 372  my $logger = WarnLogger->new;
 373  with_logger $logger => sub {
 374     if (1 == 0) {
 375        log_fatal { 'Non Logical Universe Detected' };
 376     } else {
 377        log_info  { 'All is good' };
 378     }
 379  };
 380
 381 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
 382
 383 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
 384 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
 385 C<CodeRef> if needed.
 386
 387 =head2 log_$level
 388
 389 Import Tag: C<:log>
 390
 391 Arguments: C<CodeRef $returning_message, @args>
 392
 393 All of the following six functions work the same except that a different method
 394 is called on the underlying C<$logger> object.  The basic pattern is:
 395
 396  sub log_$level (&@) {
 397    if ($logger->is_$level) {
 398      $logger->$level(shift->(@_));
 399    }
 400    @_
 401  }
 402
 403 Note that the function returns it's arguments.  This can be used in a number of
 404 ways, but often it's convenient just for partial inspection of passthrough data
 405
 406  my @friends = log_trace {
 407    'friends list being generated, data from first friend: ' .
 408      Dumper($_[0]->TO_JSON)
 409  } generate_friend_list();
 410
 411 If you want complete inspection of passthrough data, take a look at the
 412 L</Dlog_$level> functions.
 413
 414 =head3 log_trace
 415
 416  log_trace { 'entered method foo with args ' join q{,}, @args };
 417
 418 =head3 log_debug
 419
 420  log_debug { 'entered method foo' };
 421
 422 =head3 log_info
 423
 424  log_info { 'started process foo' };
 425
 426 =head3 log_warn
 427
 428  log_warn { 'possible misconfiguration at line 10' };
 429
 430 =head3 log_error
 431
 432  log_error { 'non-numeric user input!' };
 433
 434 =head3 log_fatal
 435
 436  log_fatal { '1 is never equal to 0!' };
 437
 438 =head2 logS_$level
 439
 440 Import Tag: C<:log>
 441
 442 Arguments: C<CodeRef $returning_message, Item $arg>
 443
 444 This is really just a special case of the L</log_$level> functions.  It forces
 445 scalar context when that is what you need.  Other than that it works exactly
 446 same:
 447
 448  my $friend = logS_trace {
 449    'I only have one friend: ' .  Dumper($_[0]->TO_JSON)
 450  } friend();
 451
 452 See also: L</DlogS_$level>.
 453
 454 =head2 Dlog_$level
 455
 456 Import Tag: C<:dlog>
 457
 458 Arguments: C<CodeRef $returning_message, @args>
 459
 460 All of the following six functions work the same as their L</log_$level>
 461 brethren, except they return what is passed into them and put the stringified
 462 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 463 you can do cool things like the following:
 464
 465  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 466
 467 and the output might look something like:
 468
 469  names: "fREW"
 470  "fRIOUX"
 471  "fROOH"
 472  "fRUE"
 473  "fiSMBoC"
 474
 475 =head3 Dlog_trace
 476
 477  my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
 478
 479 =head3 Dlog_debug
 480
 481  Dlog_debug { "random data structure: $_" } { foo => $bar };
 482
 483 =head3 Dlog_info
 484
 485  return Dlog_info { "html from method returned: $_" } "<html>...</html>";
 486
 487 =head3 Dlog_warn
 488
 489  Dlog_warn { "probably invalid value: $_" } $foo;
 490
 491 =head3 Dlog_error
 492
 493  Dlog_error { "non-numeric user input! ($_)" } $port;
 494
 495 =head3 Dlog_fatal
 496
 497  Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 498
 499 =head2 DlogS_$level
 500
 501 Import Tag: C<:dlog>
 502
 503 Arguments: C<CodeRef $returning_message, Item $arg>
 504
 505 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
 506 They only take a single scalar after the C<$returning_message> instead of
 507 slurping up (and also setting C<wantarray>) all the C<@args>
 508
 509  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 510    $schema->resultset('Pals')->search({ perlers => 1 });
 511
 512 =head1 LOGGER INTERFACE
 513
 514 Because this module is ultimately pretty looking glue (glittery?) with the
 515 awesome benefit of the Contextual part, users will often want to make their
 516 favorite logger work with it.  The following are the methods that should be
 517 implemented in the logger:
 518
 519  is_trace
 520  is_debug
 521  is_info
 522  is_warn
 523  is_error
 524  is_fatal
 525  trace
 526  debug
 527  info
 528  warn
 529  error
 530  fatal
 531
 532 The first six merely need to return true if that level is enabled.  The latter
 533 six take the results of whatever the user returned from their coderef and log
 534 them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 535
 536 =head1 AUTHOR
 537
 538 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 539
 540 =head1 DESIGNER
 541
 542 mst - Matt S. Trout <mst@shadowcat.co.uk>
 543
 544 =head1 COPYRIGHT
 545
 546 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 547 above.
 548
 549 =head1 LICENSE
 550
 551 This library is free software and may be distributed under the same terms as
 552 Perl 5 itself.
 553
 554 =cut
 555