lib/Log/Contextual.pm

   1 package Log::Contextual;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.00100';
   7
   8 require Exporter;
   9 use Data::Dumper::Concise;
  10
  11 BEGIN { our @ISA = qw(Exporter) }
  12
  13 my @dlog = (qw(
  14    Dlog_debug DlogS_debug
  15    Dlog_trace DlogS_trace
  16    Dlog_warn DlogS_warn
  17    Dlog_info DlogS_info
  18    Dlog_error DlogS_error
  19    Dlog_fatal DlogS_fatal
  20  ));
  21
  22 my @log = (qw(
  23    log_debug logS_debug
  24    log_trace logS_trace
  25    log_warn logS_warn
  26    log_info logS_info
  27    log_error logS_error
  28    log_fatal logS_fatal
  29  ));
  30
  31 our @EXPORT_OK = (
  32    @dlog, @log,
  33    qw( set_logger with_logger )
  34 );
  35
  36 our %EXPORT_TAGS = (
  37    dlog => \@dlog,
  38    log  => \@log,
  39    all  => [@dlog, @log],
  40 );
  41
  42 sub import {
  43    my $package = shift;
  44    die 'Log::Contextual does not have a default import list'
  45       unless @_;
  46
  47    for my $idx ( 0 .. $#_ ) {
  48       if ( $_[$idx] eq '-logger' ) {
  49          set_logger($_[$idx + 1]);
  50          splice @_, $idx, 2;
  51          last;
  52       }
  53    }
  54    $package->export_to_level(1, $package, @_);
  55 }
  56
  57 our $Get_Logger;
  58
  59 sub set_logger {
  60    my $logger = $_[0];
  61    $logger = do { my $l = $logger; sub { $l } }
  62       if ref $logger ne 'CODE';
  63    $Get_Logger = $logger;
  64 }
  65
  66 sub with_logger {
  67    my $logger = $_[0];
  68    $logger = do { my $l = $logger; sub { $l } }
  69       if ref $logger ne 'CODE';
  70    local $Get_Logger = $logger;
  71    $_[1]->();
  72 }
  73
  74
  75
  76 sub log_trace (&@) {
  77    my $log  = $Get_Logger->();
  78    my $code = shift;
  79    $log->trace($code->(@_))
  80       if $log->is_trace;
  81    @_
  82 }
  83
  84 sub log_debug (&@) {
  85    my $log  = $Get_Logger->();
  86    my $code = shift;
  87    $log->debug($code->(@_))
  88       if $log->is_debug;
  89    @_
  90 }
  91
  92 sub log_info (&@) {
  93    my $log  = $Get_Logger->();
  94    my $code = shift;
  95    $log->info($code->(@_))
  96       if $log->is_info;
  97    @_
  98 }
  99
 100 sub log_warn (&@) {
 101    my $log  = $Get_Logger->();
 102    my $code = shift;
 103    $log->warn($code->(@_))
 104       if $log->is_warn;
 105    @_
 106 }
 107
 108 sub log_error (&@) {
 109    my $log  = $Get_Logger->();
 110    my $code = shift;
 111    $log->error($code->(@_))
 112       if $log->is_error;
 113    @_
 114 }
 115
 116 sub log_fatal (&@) {
 117    my $log  = $Get_Logger->();
 118    my $code = shift;
 119    $log->fatal($code->(@_))
 120       if $log->is_fatal;
 121    @_
 122 }
 123
 124
 125 sub logS_trace (&$) {
 126    my $log  = $Get_Logger->();
 127    my $code = shift;
 128    my $value = shift;
 129    $log->trace($code->($value))
 130       if $log->is_trace;
 131    $value
 132 }
 133
 134 sub logS_debug (&$) {
 135    my $log  = $Get_Logger->();
 136    my $code = shift;
 137    my $value = shift;
 138    $log->debug($code->($value))
 139       if $log->is_debug;
 140    $value
 141 }
 142
 143 sub logS_info (&$) {
 144    my $log  = $Get_Logger->();
 145    my $code = shift;
 146    my $value = shift;
 147    $log->info($code->($value))
 148       if $log->is_info;
 149    $value
 150 }
 151
 152 sub logS_warn (&$) {
 153    my $log  = $Get_Logger->();
 154    my $code = shift;
 155    my $value = shift;
 156    $log->warn($code->($value))
 157       if $log->is_warn;
 158    $value
 159 }
 160
 161 sub logS_error (&$) {
 162    my $log  = $Get_Logger->();
 163    my $code = shift;
 164    my $value = shift;
 165    $log->error($code->($value))
 166       if $log->is_error;
 167    $value
 168 }
 169
 170 sub logS_fatal (&$) {
 171    my $log  = $Get_Logger->();
 172    my $code = shift;
 173    my $value = shift;
 174    $log->fatal($code->($value))
 175       if $log->is_fatal;
 176    $value
 177 }
 178
 179
 180
 181 sub Dlog_trace (&@) {
 182   my $code = shift;
 183   my @values = @_;
 184   return log_trace {
 185      if (@values) {
 186         do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 187      } else {
 188         do { local $_ = '()'; $code->() };
 189      }
 190   } @values
 191 }
 192
 193 sub Dlog_debug (&@) {
 194   my $code = shift;
 195   my @values = @_;
 196   log_debug {
 197      if (@values) {
 198         do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 199      } else {
 200         do { local $_ = '()'; $code->() };
 201      }
 202   } @values
 203 }
 204
 205 sub Dlog_info (&@) {
 206   my $code = shift;
 207   my @values = @_;
 208   log_info {
 209      if (@values) {
 210         do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 211      } else {
 212         do { local $_ = '()'; $code->() };
 213      }
 214   } @values
 215 }
 216
 217 sub Dlog_warn (&@) {
 218   my $code = shift;
 219   my @values = @_;
 220   log_warn {
 221      if (@values) {
 222         do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 223      } else {
 224         do { local $_ = '()'; $code->() };
 225      }
 226   } @values
 227 }
 228
 229 sub Dlog_error (&@) {
 230   my $code = shift;
 231   my @values = @_;
 232   log_error {
 233      if (@values) {
 234         do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 235      } else {
 236         do { local $_ = '()'; $code->() };
 237      }
 238   } @values
 239 }
 240
 241 sub Dlog_fatal (&@) {
 242   my $code = shift;
 243   my @values = @_;
 244   log_fatal {
 245      if (@values) {
 246         do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 247      } else {
 248         do { local $_ = '()'; $code->() };
 249      }
 250   } @values
 251 }
 252
 253
 254
 255 sub DlogS_trace (&$) {
 256   my $code = $_[0];
 257   my $value = $_[1];
 258   logS_trace {
 259      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 260   } $value
 261 }
 262
 263 sub DlogS_debug (&$) {
 264   my $code = $_[0];
 265   my $value = $_[1];
 266   logS_debug {
 267      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 268   } $value
 269 }
 270
 271 sub DlogS_info (&$) {
 272   my $code = $_[0];
 273   my $value = $_[1];
 274   logS_info {
 275      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 276   } $value
 277 }
 278
 279 sub DlogS_warn (&$) {
 280   my $code = $_[0];
 281   my $value = $_[1];
 282   logS_warn {
 283      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 284   } $value
 285 }
 286
 287 sub DlogS_error (&$) {
 288   my $code = $_[0];
 289   my $value = $_[1];
 290   logS_error {
 291      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 292   } $value
 293 }
 294
 295 sub DlogS_fatal (&$) {
 296   my $code = $_[0];
 297   my $value = $_[1];
 298   logS_fatal {
 299      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 300   } $value
 301 }
 302
 303 1;
 304
 305 __END__
 306
 307 =head1 NAME
 308
 309 Log::Contextual - Simple logging interface with a contextual log
 310
 311 =head1 SYNOPSIS
 312
 313  use Log::Log4perl;
 314  use Log::Contextual qw( :log :dlog set_logger with_logger );
 315
 316  my $logger  = sub { Log::Log4perl->get_logger };
 317
 318  set_logger { $logger };
 319
 320  log_debug { 'program started' };
 321
 322  sub foo {
 323    with_logger(Log::Contextual::SimpleLogger->new({
 324        levels => [qw( trace debug )]
 325      }) => sub {
 326      log_trace { 'foo entered' };
 327      my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
 328      # ...
 329      log_trace { 'foo left' };
 330    });
 331  }
 332
 333 =head1 DESCRIPTION
 334
 335 This module is a simple interface to extensible logging.  It is bundled with a
 336 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
 337 should use a real logger instead of that.  For something more serious but not
 338 overly complicated, take a look at L<Log::Dispatchouli>.
 339
 340 =head1 OPTIONS
 341
 342 When you import this module you may use C<-logger> as a shortcut for
 343 L<set_logger>, for example:
 344
 345  use Log::Contextual::SimpleLogger;
 346  use Log::Contextual qw( :dlog ),
 347    -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
 348
 349 sometimes you might want to have the logger handy for other stuff, in which
 350 case you might try something like the following:
 351
 352  my $var_log;
 353  BEGIN { $var_log = VarLogger->new }
 354  use Log::Contextual qw( :dlog ), -logger => $var_log;
 355
 356 =head1 A WORK IN PROGRESS
 357
 358 This module is certainly not complete, but we will not break the interface
 359 lightly, so I would say it's safe to use in production code.  The main result
 360 from that at this point is that doing:
 361
 362  use Log::Contextual;
 363
 364 will die as we do not yet know what the defaults should be.  If it turns out
 365 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
 366 probably make C<:log> the default.  But only time and usage will tell.
 367
 368 =head1 FUNCTIONS
 369
 370 =head2 set_logger
 371
 372  my $logger = WarnLogger->new;
 373  set_logger $logger;
 374
 375 Arguments: C<Ref|CodeRef $returning_logger>
 376
 377 C<set_logger> will just set the current logger to whatever you pass it.  It
 378 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
 379 C<CodeRef> for you.
 380
 381 =head2 with_logger
 382
 383  my $logger = WarnLogger->new;
 384  with_logger $logger => sub {
 385     if (1 == 0) {
 386        log_fatal { 'Non Logical Universe Detected' };
 387     } else {
 388        log_info  { 'All is good' };
 389     }
 390  };
 391
 392 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
 393
 394 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
 395 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
 396 C<CodeRef> if needed.
 397
 398 =head2 log_$level
 399
 400 Import Tag: C<:log>
 401
 402 Arguments: C<CodeRef $returning_message, @args>
 403
 404 All of the following six functions work the same except that a different method
 405 is called on the underlying C<$logger> object.  The basic pattern is:
 406
 407  sub log_$level (&@) {
 408    if ($logger->is_$level) {
 409      $logger->$level(shift->(@_));
 410    }
 411    @_
 412  }
 413
 414 Note that the function returns it's arguments.  This can be used in a number of
 415 ways, but often it's convenient just for partial inspection of passthrough data
 416
 417  my @friends = log_trace {
 418    'friends list being generated, data from first friend: ' .
 419      Dumper($_[0]->TO_JSON)
 420  } generate_friend_list();
 421
 422 If you want complete inspection of passthrough data, take a look at the
 423 L</Dlog_$level> functions.
 424
 425 =head3 log_trace
 426
 427  log_trace { 'entered method foo with args ' join q{,}, @args };
 428
 429 =head3 log_debug
 430
 431  log_debug { 'entered method foo' };
 432
 433 =head3 log_info
 434
 435  log_info { 'started process foo' };
 436
 437 =head3 log_warn
 438
 439  log_warn { 'possible misconfiguration at line 10' };
 440
 441 =head3 log_error
 442
 443  log_error { 'non-numeric user input!' };
 444
 445 =head3 log_fatal
 446
 447  log_fatal { '1 is never equal to 0!' };
 448
 449 =head2 logS_$level
 450
 451 Import Tag: C<:log>
 452
 453 Arguments: C<CodeRef $returning_message, Item $arg>
 454
 455 This is really just a special case of the L</log_$level> functions.  It forces
 456 scalar context when that is what you need.  Other than that it works exactly
 457 same:
 458
 459  my $friend = logS_trace {
 460    'I only have one friend: ' .  Dumper($_[0]->TO_JSON)
 461  } friend();
 462
 463 See also: L</DlogS_$level>.
 464
 465 =head2 Dlog_$level
 466
 467 Import Tag: C<:dlog>
 468
 469 Arguments: C<CodeRef $returning_message, @args>
 470
 471 All of the following six functions work the same as their L</log_$level>
 472 brethren, except they return what is passed into them and put the stringified
 473 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 474 you can do cool things like the following:
 475
 476  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 477
 478 and the output might look something like:
 479
 480  names: "fREW"
 481  "fRIOUX"
 482  "fROOH"
 483  "fRUE"
 484  "fiSMBoC"
 485
 486 =head3 Dlog_trace
 487
 488  my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
 489
 490 =head3 Dlog_debug
 491
 492  Dlog_debug { "random data structure: $_" } { foo => $bar };
 493
 494 =head3 Dlog_info
 495
 496  return Dlog_info { "html from method returned: $_" } "<html>...</html>";
 497
 498 =head3 Dlog_warn
 499
 500  Dlog_warn { "probably invalid value: $_" } $foo;
 501
 502 =head3 Dlog_error
 503
 504  Dlog_error { "non-numeric user input! ($_)" } $port;
 505
 506 =head3 Dlog_fatal
 507
 508  Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 509
 510 =head2 DlogS_$level
 511
 512 Import Tag: C<:dlog>
 513
 514 Arguments: C<CodeRef $returning_message, Item $arg>
 515
 516 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
 517 They only take a single scalar after the C<$returning_message> instead of
 518 slurping up (and also setting C<wantarray>) all the C<@args>
 519
 520  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 521    $schema->resultset('Pals')->search({ perlers => 1 });
 522
 523 =head1 LOGGER INTERFACE
 524
 525 Because this module is ultimately pretty looking glue (glittery?) with the
 526 awesome benefit of the Contextual part, users will often want to make their
 527 favorite logger work with it.  The following are the methods that should be
 528 implemented in the logger:
 529
 530  is_trace
 531  is_debug
 532  is_info
 533  is_warn
 534  is_error
 535  is_fatal
 536  trace
 537  debug
 538  info
 539  warn
 540  error
 541  fatal
 542
 543 The first six merely need to return true if that level is enabled.  The latter
 544 six take the results of whatever the user returned from their coderef and log
 545 them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 546
 547 =head1 AUTHOR
 548
 549 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 550
 551 =head1 DESIGNER
 552
 553 mst - Matt S. Trout <mst@shadowcat.co.uk>
 554
 555 =head1 COPYRIGHT
 556
 557 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 558 above.
 559
 560 =head1 LICENSE
 561
 562 This library is free software and may be distributed under the same terms as
 563 Perl 5 itself.
 564
 565 =cut
 566