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: 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: 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: ":log"
 401
 402 Arguments: CodeRef $returning_message
 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 =head3 log_trace
 414
 415  log_trace { 'entered method foo with args ' join q{,}, @args };
 416
 417 =head3 log_debug
 418
 419  log_debug { 'entered method foo' };
 420
 421 =head3 log_info
 422
 423  log_info { 'started process foo' };
 424
 425 =head3 log_warn
 426
 427  log_warn { 'possible misconfiguration at line 10' };
 428
 429 =head3 log_error
 430
 431  log_error { 'non-numeric user input!' };
 432
 433 =head3 log_fatal
 434
 435  log_fatal { '1 is never equal to 0!' };
 436
 437 =head2 Dlog_$level
 438
 439 Import Tag: ":dlog"
 440
 441 Arguments: CodeRef $returning_message, @args
 442
 443 All of the following six functions work the same as their L<log_$level>
 444 brethren, except they return what is passed into them and put the stringified
 445 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 446 you can do cool things like the following:
 447
 448  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 449
 450 and the output might look something like:
 451
 452  names: "fREW"
 453  "fRIOUX"
 454  "fROOH"
 455  "fRUE"
 456  "fiSMBoC"
 457
 458 =head3 Dlog_trace
 459
 460  my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
 461
 462 =head3 Dlog_debug
 463
 464  Dlog_debug { "random data structure: $_" } { foo => $bar };
 465
 466 =head3 Dlog_info
 467
 468  return Dlog_info { "html from method returned: $_" } "<html>...</html>";
 469
 470 =head3 Dlog_warn
 471
 472  Dlog_warn { "probably invalid value: $_" } $foo;
 473
 474 =head3 Dlog_error
 475
 476  Dlog_error { "non-numeric user input! ($_)" } $port;
 477
 478 =head3 Dlog_fatal
 479
 480  Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 481
 482 =head2 DlogS_$level
 483
 484 Import Tag: ":dlog"
 485
 486 Arguments: CodeRef $returning_message, Item $arg
 487
 488 All of the following six functions work the same as the related L<Dlog_$level>
 489 functions, except they only take a single scalar after the
 490 C<$returning_message> instead of slurping up (and also setting C<wantarray>)
 491 all the C<@args>
 492
 493  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 494    $schema->resultset('Pals')->search({ perlers => 1 });
 495
 496 =head3 DlogS_trace
 497
 498  my ($foo, $bar) =
 499    DlogS_trace { "entered method foo with first arg $_" } $_[0], $_[1];
 500
 501 =head3 DlogS_debug
 502
 503  DlogS_debug { "random data structure: $_" } { foo => $bar };
 504
 505 =head3 DlogS_info
 506
 507  return DlogS_info { "html from method returned: $_" } "<html>...</html>";
 508
 509 =head3 DlogS_warn
 510
 511  DlogS_warn { "probably invalid value: $_" } $foo;
 512
 513 =head3 DlogS_error
 514
 515  DlogS_error { "non-numeric user input! ($_)" } $port;
 516
 517 =head3 DlogS_fatal
 518
 519  DlogS_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 520
 521 =head1 LOGGER INTERFACE
 522
 523 Because this module is ultimately pretty looking glue (glittery?) with the
 524 awesome benefit of the Contextual part, users will often want to make their
 525 favorite logger work with it.  The following are the methods that should be
 526 implemented in the logger:
 527
 528  is_trace
 529  is_debug
 530  is_info
 531  is_warn
 532  is_error
 533  is_fatal
 534  trace
 535  debug
 536  info
 537  warn
 538  error
 539  fatal
 540
 541 The first six merely need to return true if that level is enabled.  The latter
 542 six take the results of whatever the user returned from their coderef and log
 543 them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 544
 545 =head1 AUTHOR
 546
 547 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 548
 549 =head1 DESIGNER
 550
 551 mst - Matt S. Trout <mst@shadowcat.co.uk>
 552
 553 =head1 COPYRIGHT
 554
 555 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 556 above.
 557
 558 =head1 LICENSE
 559
 560 This library is free software and may be distributed under the same terms as
 561 Perl 5 itself.
 562
 563 =cut
 564