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