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 );
  40
  41 sub import {
  42    my $package = shift;
  43    die 'Log::Contextual does not have a default import list'
  44       unless @_;
  45
  46    for my $idx ( 0 .. $#_ ) {
  47       if ( $_[$idx] eq '-logger' ) {
  48          set_logger($_[$idx + 1]);
  49          splice @_, $idx, 2;
  50          last;
  51       }
  52    }
  53    $package->export_to_level(1, $package, @_);
  54 }
  55
  56 our $Get_Logger;
  57
  58 sub set_logger {
  59    my $logger = $_[0];
  60    $logger = do { my $l = $logger; sub { $l } }
  61       if ref $logger ne 'CODE';
  62    $Get_Logger = $logger;
  63 }
  64
  65 sub with_logger {
  66    my $logger = $_[0];
  67    $logger = do { my $l = $logger; sub { $l } }
  68       if ref $logger ne 'CODE';
  69    local $Get_Logger = $logger;
  70    $_[1]->();
  71 }
  72
  73 sub log_trace (&) {
  74    my $log = $Get_Logger->();
  75    $log->trace($_[0]->())
  76       if $log->is_trace;
  77 }
  78
  79 sub log_debug (&) {
  80    my $log = $Get_Logger->();
  81    $log->debug($_[0]->())
  82       if $log->is_debug;
  83 }
  84
  85 sub log_info (&) {
  86    my $log = $Get_Logger->();
  87    $log->info($_[0]->())
  88       if $log->is_info;
  89 }
  90
  91 sub log_warn (&) {
  92    my $log = $Get_Logger->();
  93    $log->warn($_[0]->())
  94       if $log->is_warn;
  95 }
  96
  97 sub log_error (&) {
  98    my $log = $Get_Logger->();
  99    $log->error($_[0]->())
 100       if $log->is_error;
 101 }
 102
 103 sub log_fatal (&) {
 104    my $log = $Get_Logger->();
 105    $log->fatal($_[0]->())
 106       if $log->is_fatal;
 107 }
 108
 109
 110
 111 sub Dlog_trace (&@) {
 112   my $code = shift;
 113   my @values = @_;
 114   log_trace {
 115      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 116   };
 117   @values
 118 }
 119
 120 sub DlogS_trace (&$) {
 121   my $code = $_[0];
 122   my $value = $_[1];
 123   log_trace {
 124      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 125   };
 126   $value
 127 }
 128
 129 sub Dlog_debug (&@) {
 130   my $code = shift;
 131   my @values = @_;
 132   log_debug {
 133      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 134   };
 135   @values
 136 }
 137
 138 sub DlogS_debug (&$) {
 139   my $code = $_[0];
 140   my $value = $_[1];
 141   log_debug {
 142      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 143   };
 144   $value
 145 }
 146
 147 sub Dlog_info (&@) {
 148   my $code = shift;
 149   my @values = @_;
 150   log_info {
 151      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 152   };
 153   @values
 154 }
 155
 156 sub DlogS_info (&$) {
 157   my $code = $_[0];
 158   my $value = $_[1];
 159   log_info {
 160      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 161   };
 162   $value
 163 }
 164
 165 sub Dlog_warn (&@) {
 166   my $code = shift;
 167   my @values = @_;
 168   log_warn {
 169      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 170   };
 171   @values
 172 }
 173
 174 sub DlogS_warn (&$) {
 175   my $code = $_[0];
 176   my $value = $_[1];
 177   log_warn {
 178      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 179   };
 180   $value
 181 }
 182
 183 sub Dlog_error (&@) {
 184   my $code = shift;
 185   my @values = @_;
 186   log_error {
 187      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 188   };
 189   @values
 190 }
 191
 192 sub DlogS_error (&$) {
 193   my $code = $_[0];
 194   my $value = $_[1];
 195   log_error {
 196      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 197   };
 198   $value
 199 }
 200
 201 sub Dlog_fatal (&@) {
 202   my $code = shift;
 203   my @values = @_;
 204   log_fatal {
 205      do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
 206   };
 207   @values
 208 }
 209
 210 sub DlogS_fatal (&$) {
 211   my $code = $_[0];
 212   my $value = $_[1];
 213   log_fatal {
 214      do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
 215   };
 216   $value
 217 }
 218
 219 1;
 220
 221 __END__
 222
 223 =head1 NAME
 224
 225 Log::Contextual - Super simple logging interface
 226
 227 =head1 SYNOPSIS
 228
 229  use Log::Contextual qw{:log set_logger with_logger};
 230
 231  my $logger  = Log::Contextual::SimpleLogger->new({ levels => [qw{debug}]});
 232
 233  set_logger { $logger };
 234
 235  log_debug { "program started" };
 236
 237  sub foo {
 238    with_logger Log::Contextual::SimpleLogger->new({
 239        levels => [qw{trace debug}]
 240      }) => sub {
 241      log_trace { 'foo entered' };
 242      # ...
 243      log_trace { 'foo left' };
 244    };
 245  }
 246
 247 =head1 DESCRIPTION
 248
 249 This module is a simple interface to extensible logging.
 250
 251 =head1 FUNCTIONS
 252
 253 =head2 set_logger
 254
 255  my $logger = WarnLogger->new;
 256  set_logger $logger;
 257
 258 Arguments: Ref|CodeRef $returning_logger
 259
 260 C<set_logger> will just set the current logger to whatever you pass it.  It
 261 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
 262 C<CodeRef> for you.
 263
 264 =head2 with_logger
 265
 266  my $logger = WarnLogger->new;
 267  with_logger $logger => sub {
 268     if (1 == 0) {
 269        log_fatal { 'Non Logical Universe Detected' };
 270     } else {
 271        log_info  { 'All is good' };
 272     }
 273  };
 274
 275 Arguments: Ref|CodeRef $returning_logger, CodeRef $to_execute
 276
 277 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
 278 as with L<set_logger>, C<with_logger> will wrap C<$returning_logger> with a
 279 C<CodeRef> if needed.
 280
 281 =head2 log_$level
 282
 283 Arguments: CodeRef $returning_message
 284
 285 All of the following six functions work the same except that a different method
 286 is called on the underlying C<$logger> object.  The basic pattern is:
 287
 288  sub log_$level (&) {
 289    if ($logger->is_$level) {
 290      $logger->$level(shift->());
 291    }
 292  }
 293
 294 =head3 log_trace
 295
 296  log_trace { 'entered method foo with args ' join q{,}, @args };
 297
 298 =head3 log_debug
 299
 300  log_debug { 'entered method foo' };
 301
 302 =head3 log_info
 303
 304  log_info { 'started process foo' };
 305
 306 =head3 log_warn
 307
 308  log_warn { 'possible misconfiguration at line 10' };
 309
 310 =head3 log_error
 311
 312  log_error { 'non-numeric user input!' };
 313
 314 =head3 log_fatal
 315
 316  log_fatal { '1 is never equal to 0!' };
 317
 318 =head2 Dlog_$level
 319
 320 Arguments: CodeRef $returning_message, @args
 321
 322 All of the following six functions work the same as their L<log_$level> brethren,
 323 except they return what is passed into them and as a bonus put the stringified
 324 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 325 you can do cool things like the following:
 326
 327  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 328
 329 and the output might look something like:
 330
 331  names: "fREW"
 332  "fRIOUX"
 333  "fROOH"
 334  "fRUE"
 335  "fiSMBoC"
 336
 337 =head3 Dlog_trace
 338
 339  my ($foo, $bar) = Dlog_trace { "entered method foo with args $_" } @_;
 340
 341 =head3 Dlog_debug
 342
 343  Dlog_debug { "random data structure: $_" } { foo => $bar };
 344
 345 =head3 Dlog_info
 346
 347  return Dlog_info { "html from method returned: $_" } "<html>...</html>";
 348
 349 =head3 Dlog_warn
 350
 351  Dlog_warn { "probably invalid value: $_" } $foo;
 352
 353 =head3 Dlog_error
 354
 355  Dlog_error { "non-numeric user input! ($_)" } $port;
 356
 357 =head3 Dlog_fatal
 358
 359  Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 360
 361 =head2 DlogS_$level
 362
 363 Arguments: CodeRef $returning_message, Item $arg
 364
 365 All of the following six functions work the same as the related L<Dlog_$level>
 366 functions, except they only take a single scalar after the
 367 C<$returning_message> instead of slurping up (and also setting C<wantarray>)
 368 all the C<@args>
 369
 370  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 371    $schema->resultset('Pals')->search({ perlers => 1 });
 372
 373 =head3 DlogS_trace
 374
 375  my ($foo, $bar) = DlogS_trace { "entered method foo with first arg $_" } @_;
 376
 377 =head3 DlogS_debug
 378
 379  DlogS_debug { "random data structure: $_" } { foo => $bar };
 380
 381 =head3 DlogS_info
 382
 383  return DlogS_info { "html from method returned: $_" } "<html>...</html>";
 384
 385 =head3 DlogS_warn
 386
 387  DlogS_warn { "probably invalid value: $_" } $foo;
 388
 389 =head3 DlogS_error
 390
 391  DlogS_error { "non-numeric user input! ($_)" } $port;
 392
 393 =head3 DlogS_fatal
 394
 395  DlogS_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 396
 397 =head1 AUTHOR
 398
 399 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 400
 401 =head1 DESIGNER
 402
 403 mst - Matt S. Trout <mst@shadowcat.co.uk>
 404
 405 =head1 COPYRIGHT
 406
 407 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 408 above.
 409
 410 =head1 LICENSE
 411
 412 This library is free software and may be distributed under the same terms as
 413 Perl 5 itself.
 414
 415 =cut
 416