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