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 sub log_trace (&@) {
  75    my $log  = $Get_Logger->();
  76    my $code = shift;
  77    $log->trace($code->(@_))
  78       if $log->is_trace;
  79    @_
  80 }
  81
  82 sub log_debug (&@) {
  83    my $log  = $Get_Logger->();
  84    my $code = shift;
  85    $log->debug($code->(@_))
  86       if $log->is_debug;
  87    @_
  88 }
  89
  90 sub log_info (&@) {
  91    my $log  = $Get_Logger->();
  92    my $code = shift;
  93    $log->info($code->(@_))
  94       if $log->is_info;
  95    @_
  96 }
  97
  98 sub log_warn (&@) {
  99    my $log  = $Get_Logger->();
 100    my $code = shift;
 101    $log->warn($code->(@_))
 102       if $log->is_warn;
 103    @_
 104 }
 105
 106 sub log_error (&@) {
 107    my $log  = $Get_Logger->();
 108    my $code = shift;
 109    $log->error($code->(@_))
 110       if $log->is_error;
 111    @_
 112 }
 113
 114 sub log_fatal (&@) {
 115    my $log  = $Get_Logger->();
 116    my $code = shift;
 117    $log->fatal($code->(@_))
 118       if $log->is_fatal;
 119    @_
 120 }
 121
 122
 123
 124 sub Dlog_trace (&@) {
 125   my $code = shift;
 126   my @values = @_;
 127   return log_trace {
 128      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 129   } @values
 130 }
 131
 132 sub DlogS_trace (&$) {
 133   my $code = $_[0];
 134   my $value = $_[1];
 135   log_trace {
 136      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 137   };
 138   $value
 139 }
 140
 141 sub Dlog_debug (&@) {
 142   my $code = shift;
 143   my @values = @_;
 144   log_debug {
 145      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 146   } @values
 147 }
 148
 149 sub DlogS_debug (&$) {
 150   my $code = $_[0];
 151   my $value = $_[1];
 152   log_debug {
 153      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 154   };
 155   $value
 156 }
 157
 158 sub Dlog_info (&@) {
 159   my $code = shift;
 160   my @values = @_;
 161   log_info {
 162      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 163   } @values
 164 }
 165
 166 sub DlogS_info (&$) {
 167   my $code = $_[0];
 168   my $value = $_[1];
 169   log_info {
 170      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 171   };
 172   $value
 173 }
 174
 175 sub Dlog_warn (&@) {
 176   my $code = shift;
 177   my @values = @_;
 178   log_warn {
 179      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 180   } @values
 181 }
 182
 183 sub DlogS_warn (&$) {
 184   my $code = $_[0];
 185   my $value = $_[1];
 186   log_warn {
 187      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 188   };
 189   $value
 190 }
 191
 192 sub Dlog_error (&@) {
 193   my $code = shift;
 194   my @values = @_;
 195   log_error {
 196      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 197   } @values
 198 }
 199
 200 sub DlogS_error (&$) {
 201   my $code = $_[0];
 202   my $value = $_[1];
 203   log_error {
 204      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 205   };
 206   $value
 207 }
 208
 209 sub Dlog_fatal (&@) {
 210   my $code = shift;
 211   my @values = @_;
 212   log_fatal {
 213      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 214   } @values
 215 }
 216
 217 sub DlogS_fatal (&$) {
 218   my $code = $_[0];
 219   my $value = $_[1];
 220   log_fatal {
 221      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 222   };
 223   $value
 224 }
 225
 226 1;
 227
 228 __END__
 229
 230 =head1 NAME
 231
 232 Log::Contextual - Simple logging interface with a contextual log
 233
 234 =head1 SYNOPSIS
 235
 236  use Log::Log4perl;
 237  use Log::Contextual qw( :log :dlog set_logger with_logger );
 238
 239  my $logger  = sub { Log::Log4perl->get_logger };
 240
 241  set_logger { $logger };
 242
 243  log_debug { 'program started' };
 244
 245  sub foo {
 246    with_logger(Log::Contextual::SimpleLogger->new({
 247        levels => [qw( trace debug )]
 248      }) => sub {
 249      log_trace { 'foo entered' };
 250      my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
 251      # ...
 252      log_trace { 'foo left' };
 253    });
 254  }
 255
 256 =head1 DESCRIPTION
 257
 258 This module is a simple interface to extensible logging.  It is bundled with a
 259 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
 260 should use a real logger instead of that.  For something more serious but not
 261 overly complicated, take a look at L<Log::Dispatchouli>.
 262
 263 =head1 OPTIONS
 264
 265 When you import this module you may use C<-logger> as a shortcut for
 266 L<set_logger>, for example:
 267
 268  use Log::Contextual::SimpleLogger;
 269  use Log::Contextual qw( :dlog ),
 270    -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
 271
 272 sometimes you might want to have the logger handy for other stuff, in which
 273 case you might try something like the following:
 274
 275  my $var_log;
 276  BEGIN { $var_log = VarLogger->new }
 277  use Log::Contextual qw( :dlog ), -logger => $var_log;
 278
 279 =head1 A WORK IN PROGRESS
 280
 281 This module is certainly not complete, but we will not break the interface
 282 lightly, so I would say it's safe to use in production code.  The main result
 283 from that at this point is that doing:
 284
 285  use Log::Contextual;
 286
 287 will die as we do not yet know what the defaults should be.  If it turns out
 288 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
 289 probably make C<:log> the default.  But only time and usage will tell.
 290
 291 =head1 FUNCTIONS
 292
 293 =head2 set_logger
 294
 295  my $logger = WarnLogger->new;
 296  set_logger $logger;
 297
 298 Arguments: Ref|CodeRef $returning_logger
 299
 300 C<set_logger> will just set the current logger to whatever you pass it.  It
 301 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
 302 C<CodeRef> for you.
 303
 304 =head2 with_logger
 305
 306  my $logger = WarnLogger->new;
 307  with_logger $logger => sub {
 308     if (1 == 0) {
 309        log_fatal { 'Non Logical Universe Detected' };
 310     } else {
 311        log_info  { 'All is good' };
 312     }
 313  };
 314
 315 Arguments: Ref|CodeRef $returning_logger, CodeRef $to_execute
 316
 317 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
 318 As with L<set_logger>, C<with_logger> will wrap C<$returning_logger> with a
 319 C<CodeRef> if needed.
 320
 321 =head2 log_$level
 322
 323 Import Tag: ":log"
 324
 325 Arguments: CodeRef $returning_message
 326
 327 All of the following six functions work the same except that a different method
 328 is called on the underlying C<$logger> object.  The basic pattern is:
 329
 330  sub log_$level (&) {
 331    if ($logger->is_$level) {
 332      $logger->$level(shift->());
 333    }
 334  }
 335
 336 =head3 log_trace
 337
 338  log_trace { 'entered method foo with args ' join q{,}, @args };
 339
 340 =head3 log_debug
 341
 342  log_debug { 'entered method foo' };
 343
 344 =head3 log_info
 345
 346  log_info { 'started process foo' };
 347
 348 =head3 log_warn
 349
 350  log_warn { 'possible misconfiguration at line 10' };
 351
 352 =head3 log_error
 353
 354  log_error { 'non-numeric user input!' };
 355
 356 =head3 log_fatal
 357
 358  log_fatal { '1 is never equal to 0!' };
 359
 360 =head2 Dlog_$level
 361
 362 Import Tag: ":dlog"
 363
 364 Arguments: CodeRef $returning_message, @args
 365
 366 All of the following six functions work the same as their L<log_$level>
 367 brethren, except they return what is passed into them and put the stringified
 368 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 369 you can do cool things like the following:
 370
 371  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 372
 373 and the output might look something like:
 374
 375  names: "fREW"
 376  "fRIOUX"
 377  "fROOH"
 378  "fRUE"
 379  "fiSMBoC"
 380
 381 =head3 Dlog_trace
 382
 383  my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
 384
 385 =head3 Dlog_debug
 386
 387  Dlog_debug { "random data structure: $_" } { foo => $bar };
 388
 389 =head3 Dlog_info
 390
 391  return Dlog_info { "html from method returned: $_" } "<html>...</html>";
 392
 393 =head3 Dlog_warn
 394
 395  Dlog_warn { "probably invalid value: $_" } $foo;
 396
 397 =head3 Dlog_error
 398
 399  Dlog_error { "non-numeric user input! ($_)" } $port;
 400
 401 =head3 Dlog_fatal
 402
 403  Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 404
 405 =head2 DlogS_$level
 406
 407 Import Tag: ":dlog"
 408
 409 Arguments: CodeRef $returning_message, Item $arg
 410
 411 All of the following six functions work the same as the related L<Dlog_$level>
 412 functions, except they only take a single scalar after the
 413 C<$returning_message> instead of slurping up (and also setting C<wantarray>)
 414 all the C<@args>
 415
 416  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 417    $schema->resultset('Pals')->search({ perlers => 1 });
 418
 419 =head3 DlogS_trace
 420
 421  my ($foo, $bar) =
 422    DlogS_trace { "entered method foo with first arg $_" } $_[0], $_[1];
 423
 424 =head3 DlogS_debug
 425
 426  DlogS_debug { "random data structure: $_" } { foo => $bar };
 427
 428 =head3 DlogS_info
 429
 430  return DlogS_info { "html from method returned: $_" } "<html>...</html>";
 431
 432 =head3 DlogS_warn
 433
 434  DlogS_warn { "probably invalid value: $_" } $foo;
 435
 436 =head3 DlogS_error
 437
 438  DlogS_error { "non-numeric user input! ($_)" } $port;
 439
 440 =head3 DlogS_fatal
 441
 442  DlogS_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 443
 444 =head1 LOGGER INTERFACE
 445
 446 Because this module is ultimately pretty looking glue (glittery?) with the
 447 awesome benefit of the Contextual part, users will often want to make their
 448 favorite logger work with it.  The following are the methods that should be
 449 implemented in the logger:
 450
 451  is_trace
 452  is_debug
 453  is_info
 454  is_warn
 455  is_error
 456  is_fatal
 457  trace
 458  debug
 459  info
 460  warn
 461  error
 462  fatal
 463
 464 The first six merely need to return true if that level is enabled.  The latter
 465 six take the results of whatever the user returned from their coderef and log
 466 them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 467
 468 =head1 AUTHOR
 469
 470 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 471
 472 =head1 DESIGNER
 473
 474 mst - Matt S. Trout <mst@shadowcat.co.uk>
 475
 476 =head1 COPYRIGHT
 477
 478 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 479 above.
 480
 481 =head1 LICENSE
 482
 483 This library is free software and may be distributed under the same terms as
 484 Perl 5 itself.
 485
 486 =cut
 487