lib/Log/Contextual.pm

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