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