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
  24    log_trace
  25    log_warn
  26    log_info
  27    log_error
  28    log_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      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 186   } @values
 187 }
 188
 189 sub Dlog_debug (&@) {
 190   my $code = shift;
 191   my @values = @_;
 192   log_debug {
 193      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 194   } @values
 195 }
 196
 197 sub Dlog_info (&@) {
 198   my $code = shift;
 199   my @values = @_;
 200   log_info {
 201      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 202   } @values
 203 }
 204
 205 sub Dlog_warn (&@) {
 206   my $code = shift;
 207   my @values = @_;
 208   log_warn {
 209      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 210   } @values
 211 }
 212
 213 sub Dlog_error (&@) {
 214   my $code = shift;
 215   my @values = @_;
 216   log_error {
 217      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 218   } @values
 219 }
 220
 221 sub Dlog_fatal (&@) {
 222   my $code = shift;
 223   my @values = @_;
 224   log_fatal {
 225      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 226   } @values
 227 }
 228
 229
 230
 231 sub DlogS_trace (&$) {
 232   my $code = $_[0];
 233   my $value = $_[1];
 234   logS_trace {
 235      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 236   } $value
 237 }
 238
 239 sub DlogS_debug (&$) {
 240   my $code = $_[0];
 241   my $value = $_[1];
 242   logS_debug {
 243      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 244   } $value
 245 }
 246
 247 sub DlogS_info (&$) {
 248   my $code = $_[0];
 249   my $value = $_[1];
 250   logS_info {
 251      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 252   } $value
 253 }
 254
 255 sub DlogS_warn (&$) {
 256   my $code = $_[0];
 257   my $value = $_[1];
 258   logS_warn {
 259      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 260   } $value
 261 }
 262
 263 sub DlogS_error (&$) {
 264   my $code = $_[0];
 265   my $value = $_[1];
 266   logS_error {
 267      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 268   } $value
 269 }
 270
 271 sub DlogS_fatal (&$) {
 272   my $code = $_[0];
 273   my $value = $_[1];
 274   logS_fatal {
 275      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 276   } $value
 277 }
 278
 279 1;
 280
 281 __END__
 282
 283 =head1 NAME
 284
 285 Log::Contextual - Simple logging interface with a contextual log
 286
 287 =head1 SYNOPSIS
 288
 289  use Log::Log4perl;
 290  use Log::Contextual qw( :log :dlog set_logger with_logger );
 291
 292  my $logger  = sub { Log::Log4perl->get_logger };
 293
 294  set_logger { $logger };
 295
 296  log_debug { 'program started' };
 297
 298  sub foo {
 299    with_logger(Log::Contextual::SimpleLogger->new({
 300        levels => [qw( trace debug )]
 301      }) => sub {
 302      log_trace { 'foo entered' };
 303      my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
 304      # ...
 305      log_trace { 'foo left' };
 306    });
 307  }
 308
 309 =head1 DESCRIPTION
 310
 311 This module is a simple interface to extensible logging.  It is bundled with a
 312 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
 313 should use a real logger instead of that.  For something more serious but not
 314 overly complicated, take a look at L<Log::Dispatchouli>.
 315
 316 =head1 OPTIONS
 317
 318 When you import this module you may use C<-logger> as a shortcut for
 319 L<set_logger>, for example:
 320
 321  use Log::Contextual::SimpleLogger;
 322  use Log::Contextual qw( :dlog ),
 323    -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
 324
 325 sometimes you might want to have the logger handy for other stuff, in which
 326 case you might try something like the following:
 327
 328  my $var_log;
 329  BEGIN { $var_log = VarLogger->new }
 330  use Log::Contextual qw( :dlog ), -logger => $var_log;
 331
 332 =head1 A WORK IN PROGRESS
 333
 334 This module is certainly not complete, but we will not break the interface
 335 lightly, so I would say it's safe to use in production code.  The main result
 336 from that at this point is that doing:
 337
 338  use Log::Contextual;
 339
 340 will die as we do not yet know what the defaults should be.  If it turns out
 341 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
 342 probably make C<:log> the default.  But only time and usage will tell.
 343
 344 =head1 FUNCTIONS
 345
 346 =head2 set_logger
 347
 348  my $logger = WarnLogger->new;
 349  set_logger $logger;
 350
 351 Arguments: Ref|CodeRef $returning_logger
 352
 353 C<set_logger> will just set the current logger to whatever you pass it.  It
 354 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
 355 C<CodeRef> for you.
 356
 357 =head2 with_logger
 358
 359  my $logger = WarnLogger->new;
 360  with_logger $logger => sub {
 361     if (1 == 0) {
 362        log_fatal { 'Non Logical Universe Detected' };
 363     } else {
 364        log_info  { 'All is good' };
 365     }
 366  };
 367
 368 Arguments: Ref|CodeRef $returning_logger, CodeRef $to_execute
 369
 370 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
 371 As with L<set_logger>, C<with_logger> will wrap C<$returning_logger> with a
 372 C<CodeRef> if needed.
 373
 374 =head2 log_$level
 375
 376 Import Tag: ":log"
 377
 378 Arguments: CodeRef $returning_message
 379
 380 All of the following six functions work the same except that a different method
 381 is called on the underlying C<$logger> object.  The basic pattern is:
 382
 383  sub log_$level (&) {
 384    if ($logger->is_$level) {
 385      $logger->$level(shift->());
 386    }
 387  }
 388
 389 =head3 log_trace
 390
 391  log_trace { 'entered method foo with args ' join q{,}, @args };
 392
 393 =head3 log_debug
 394
 395  log_debug { 'entered method foo' };
 396
 397 =head3 log_info
 398
 399  log_info { 'started process foo' };
 400
 401 =head3 log_warn
 402
 403  log_warn { 'possible misconfiguration at line 10' };
 404
 405 =head3 log_error
 406
 407  log_error { 'non-numeric user input!' };
 408
 409 =head3 log_fatal
 410
 411  log_fatal { '1 is never equal to 0!' };
 412
 413 =head2 Dlog_$level
 414
 415 Import Tag: ":dlog"
 416
 417 Arguments: CodeRef $returning_message, @args
 418
 419 All of the following six functions work the same as their L<log_$level>
 420 brethren, except they return what is passed into them and put the stringified
 421 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 422 you can do cool things like the following:
 423
 424  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 425
 426 and the output might look something like:
 427
 428  names: "fREW"
 429  "fRIOUX"
 430  "fROOH"
 431  "fRUE"
 432  "fiSMBoC"
 433
 434 =head3 Dlog_trace
 435
 436  my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
 437
 438 =head3 Dlog_debug
 439
 440  Dlog_debug { "random data structure: $_" } { foo => $bar };
 441
 442 =head3 Dlog_info
 443
 444  return Dlog_info { "html from method returned: $_" } "<html>...</html>";
 445
 446 =head3 Dlog_warn
 447
 448  Dlog_warn { "probably invalid value: $_" } $foo;
 449
 450 =head3 Dlog_error
 451
 452  Dlog_error { "non-numeric user input! ($_)" } $port;
 453
 454 =head3 Dlog_fatal
 455
 456  Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 457
 458 =head2 DlogS_$level
 459
 460 Import Tag: ":dlog"
 461
 462 Arguments: CodeRef $returning_message, Item $arg
 463
 464 All of the following six functions work the same as the related L<Dlog_$level>
 465 functions, except they only take a single scalar after the
 466 C<$returning_message> instead of slurping up (and also setting C<wantarray>)
 467 all the C<@args>
 468
 469  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 470    $schema->resultset('Pals')->search({ perlers => 1 });
 471
 472 =head3 DlogS_trace
 473
 474  my ($foo, $bar) =
 475    DlogS_trace { "entered method foo with first arg $_" } $_[0], $_[1];
 476
 477 =head3 DlogS_debug
 478
 479  DlogS_debug { "random data structure: $_" } { foo => $bar };
 480
 481 =head3 DlogS_info
 482
 483  return DlogS_info { "html from method returned: $_" } "<html>...</html>";
 484
 485 =head3 DlogS_warn
 486
 487  DlogS_warn { "probably invalid value: $_" } $foo;
 488
 489 =head3 DlogS_error
 490
 491  DlogS_error { "non-numeric user input! ($_)" } $port;
 492
 493 =head3 DlogS_fatal
 494
 495  DlogS_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 496
 497 =head1 LOGGER INTERFACE
 498
 499 Because this module is ultimately pretty looking glue (glittery?) with the
 500 awesome benefit of the Contextual part, users will often want to make their
 501 favorite logger work with it.  The following are the methods that should be
 502 implemented in the logger:
 503
 504  is_trace
 505  is_debug
 506  is_info
 507  is_warn
 508  is_error
 509  is_fatal
 510  trace
 511  debug
 512  info
 513  warn
 514  error
 515  fatal
 516
 517 The first six merely need to return true if that level is enabled.  The latter
 518 six take the results of whatever the user returned from their coderef and log
 519 them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 520
 521 =head1 AUTHOR
 522
 523 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 524
 525 =head1 DESIGNER
 526
 527 mst - Matt S. Trout <mst@shadowcat.co.uk>
 528
 529 =head1 COPYRIGHT
 530
 531 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 532 above.
 533
 534 =head1 LICENSE
 535
 536 This library is free software and may be distributed under the same terms as
 537 Perl 5 itself.
 538
 539 =cut
 540