lib/Log/Contextual.pm

   1 package Log::Contextual;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.00305';
   7
   8 my @levels = qw(debug trace warn info error fatal);
   9
  10 use Exporter::Declare;
  11 use Exporter::Declare::Export::Generator;
  12 use Data::Dumper::Concise;
  13 use Scalar::Util 'blessed';
  14
  15 my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
  16
  17 my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
  18
  19 eval {
  20    require Log::Log4perl;
  21    die if $Log::Log4perl::VERSION < 1.29;
  22    Log::Log4perl->wrapper_register(__PACKAGE__)
  23 };
  24
  25 exports (
  26    @dlog, @log,
  27    qw( set_logger with_logger )
  28 );
  29
  30 export_tag dlog => @dlog;
  31 export_tag log  => @log;
  32 import_arguments qw(logger package_logger default_logger);
  33
  34 sub before_import {
  35    my ($class, $importer, $spec) = @_;
  36
  37    die 'Log::Contextual does not have a default import list'
  38       if $spec->config->{default};
  39
  40    my @levels = qw(debug trace warn info error fatal);
  41    if ( my $levels = $spec->config->{levels} ) {
  42       @levels = @$levels
  43    }
  44    for my $level (@levels) {
  45       if ($spec->config->{log}) {
  46          $spec->add_export("&log_$level", sub (&@) {
  47             _do_log( $level => _get_logger( caller ), shift @_, @_)
  48          });
  49          $spec->add_export("&logS_$level", sub (&@) {
  50             _do_logS( $level => _get_logger( caller ), $_[0], $_[1])
  51          });
  52       }
  53       if ($spec->config->{dlog}) {
  54          $spec->add_export("&Dlog_$level", sub (&@) {
  55            my ($code, @args) = @_;
  56            return _do_log( $level => _get_logger( caller ), sub {
  57               local $_ = (@args?Data::Dumper::Concise::Dumper @args:'()');
  58               $code->(@_)
  59            }, @args );
  60          });
  61          $spec->add_export("&DlogS_$level", sub (&$) {
  62            my ($code, $ref) = @_;
  63            _do_logS( $level => _get_logger( caller ), sub {
  64               local $_ = Data::Dumper::Concise::Dumper $ref;
  65               $code->($ref)
  66            }, $ref )
  67          });
  68       }
  69    }
  70 }
  71
  72 sub after_import {
  73    my ($class, $importer, $specs) = @_;
  74
  75    set_logger( $specs->config->{logger} )
  76       if $specs->config->{logger};
  77
  78    _set_package_logger_for( $importer, $specs->config->{package_logger} )
  79       if $specs->config->{package_logger};
  80
  81    _set_default_logger_for( $importer, $specs->config->{default_logger} )
  82       if $specs->config->{default_logger};
  83 }
  84
  85 our $Get_Logger;
  86 our %Default_Logger;
  87 our %Package_Logger;
  88
  89 sub _set_default_logger_for {
  90    my $logger = $_[1];
  91    if(ref $logger ne 'CODE') {
  92       die 'logger was not a CodeRef or a logger object.  Please try again.'
  93          unless blessed($logger);
  94       $logger = do { my $l = $logger; sub { $l } }
  95    }
  96    $Default_Logger{$_[0]} = $logger
  97 }
  98
  99 sub _set_package_logger_for {
 100    my $logger = $_[1];
 101    if(ref $logger ne 'CODE') {
 102       die 'logger was not a CodeRef or a logger object.  Please try again.'
 103          unless blessed($logger);
 104       $logger = do { my $l = $logger; sub { $l } }
 105    }
 106    $Package_Logger{$_[0]} = $logger
 107 }
 108
 109 sub _get_logger($) {
 110    my $package = shift;
 111    (
 112       $Package_Logger{$package} ||
 113       $Get_Logger ||
 114       $Default_Logger{$package} ||
 115       die q( no logger set!  you can't try to log something without a logger! )
 116    )->($package);
 117 }
 118
 119 sub set_logger {
 120    my $logger = $_[0];
 121    if(ref $logger ne 'CODE') {
 122       die 'logger was not a CodeRef or a logger object.  Please try again.'
 123          unless blessed($logger);
 124       $logger = do { my $l = $logger; sub { $l } }
 125    }
 126
 127    warn 'set_logger (or -logger) called more than once!  This is a bad idea!'
 128       if $Get_Logger;
 129    $Get_Logger = $logger;
 130 }
 131
 132 sub with_logger {
 133    my $logger = $_[0];
 134    if(ref $logger ne 'CODE') {
 135       die 'logger was not a CodeRef or a logger object.  Please try again.'
 136          unless blessed($logger);
 137       $logger = do { my $l = $logger; sub { $l } }
 138    }
 139    local $Get_Logger = $logger;
 140    $_[1]->();
 141 }
 142
 143 sub _do_log {
 144    my $level  = shift;
 145    my $logger = shift;
 146    my $code   = shift;
 147    my @values = @_;
 148
 149    $logger->$level($code->(@_))
 150       if $logger->${\"is_$level"};
 151    @values
 152 }
 153
 154 sub _do_logS {
 155    my $level  = shift;
 156    my $logger = shift;
 157    my $code   = shift;
 158    my $value  = shift;
 159
 160    $logger->$level($code->($value))
 161       if $logger->${\"is_$level"};
 162    $value
 163 }
 164
 165 1;
 166
 167 __END__
 168
 169 =head1 NAME
 170
 171 Log::Contextual - Simple logging interface with a contextual log
 172
 173 =head1 SYNOPSIS
 174
 175  use Log::Contextual qw( :log :dlog set_logger with_logger );
 176  use Log::Contextual::SimpleLogger;
 177  use Log::Log4perl ':easy';
 178  Log::Log4perl->easy_init($DEBUG);
 179
 180
 181  my $logger  = Log::Log4perl->get_logger;
 182
 183  set_logger $logger;
 184
 185  log_debug { 'program started' };
 186
 187  sub foo {
 188    with_logger(Log::Contextual::SimpleLogger->new({
 189        levels => [qw( trace debug )]
 190      }) => sub {
 191      log_trace { 'foo entered' };
 192      my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
 193      # ...
 194      log_trace { 'foo left' };
 195    });
 196  }
 197
 198  foo();
 199
 200 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
 201 with C<Log::Contextual>:
 202
 203  use Log::Contextual qw( :log :dlog set_logger );
 204  use Log::Dispatchouli;
 205  my $ld = Log::Dispatchouli->new({
 206     ident     => 'slrtbrfst',
 207     to_stderr => 1,
 208     debug     => 1,
 209  });
 210
 211  set_logger $ld;
 212
 213  log_debug { 'program started' };
 214
 215 =head1 DESCRIPTION
 216
 217 This module is a simple interface to extensible logging.  It is bundled with a
 218 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
 219 should use a real logger instead of that.  For something more serious but not
 220 overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
 221
 222 The reason for this module is to abstract your logging interface so that
 223 logging is as painless as possible, while still allowing you to switch from one
 224 logger to another.
 225
 226 =head1 OPTIONS
 227
 228 =head2 -logger
 229
 230 When you import this module you may use C<-logger> as a shortcut for
 231 L<set_logger>, for example:
 232
 233  use Log::Contextual::SimpleLogger;
 234  use Log::Contextual qw( :dlog ),
 235    -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
 236
 237 sometimes you might want to have the logger handy for other stuff, in which
 238 case you might try something like the following:
 239
 240  my $var_log;
 241  BEGIN { $var_log = VarLogger->new }
 242  use Log::Contextual qw( :dlog ), -logger => $var_log;
 243
 244 =head2 -package_logger
 245
 246 The C<-package_logger> import option is similar to the C<-logger> import option
 247 except C<-package_logger> sets the the logger for the current package.
 248
 249 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
 250 L</set_logger>.
 251
 252  package My::Package;
 253  use Log::Contextual::SimpleLogger;
 254  use Log::Contextual qw( :log ),
 255    -package_logger => Log::Contextual::WarnLogger->new({
 256       env_prefix => 'MY_PACKAGE'
 257    });
 258
 259 If you are interested in using this package for a module you are putting on
 260 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
 261
 262 =head2 -default_logger
 263
 264 The C<-default_logger> import option is similar to the C<-logger> import option
 265 except C<-default_logger> sets the the B<default> logger for the current package.
 266
 267 Basically it sets the logger to be used if C<set_logger> is never called; so
 268
 269  package My::Package;
 270  use Log::Contextual::SimpleLogger;
 271  use Log::Contextual qw( :log ),
 272    -default_logger => Log::Contextual::WarnLogger->new({
 273       env_prefix => 'MY_PACKAGE'
 274    });
 275
 276 =head1 A WORK IN PROGRESS
 277
 278 This module is certainly not complete, but we will not break the interface
 279 lightly, so I would say it's safe to use in production code.  The main result
 280 from that at this point is that doing:
 281
 282  use Log::Contextual;
 283
 284 will die as we do not yet know what the defaults should be.  If it turns out
 285 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
 286 probably make C<:log> the default.  But only time and usage will tell.
 287
 288 =head1 FUNCTIONS
 289
 290 =head2 set_logger
 291
 292  my $logger = WarnLogger->new;
 293  set_logger $logger;
 294
 295 Arguments: C<Ref|CodeRef $returning_logger>
 296
 297 C<set_logger> will just set the current logger to whatever you pass it.  It
 298 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
 299 C<CodeRef> for you.  C<set_logger> is really meant only to be called from a
 300 top-level script.  To avoid foot-shooting the function will warn if you call it
 301 more than once.
 302
 303 =head2 with_logger
 304
 305  my $logger = WarnLogger->new;
 306  with_logger $logger => sub {
 307     if (1 == 0) {
 308        log_fatal { 'Non Logical Universe Detected' };
 309     } else {
 310        log_info  { 'All is good' };
 311     }
 312  };
 313
 314 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
 315
 316 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
 317 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
 318 C<CodeRef> if needed.
 319
 320 =head2 log_$level
 321
 322 Import Tag: C<:log>
 323
 324 Arguments: C<CodeRef $returning_message, @args>
 325
 326 All of the following six functions work the same except that a different method
 327 is called on the underlying C<$logger> object.  The basic pattern is:
 328
 329  sub log_$level (&@) {
 330    if ($logger->is_$level) {
 331      $logger->$level(shift->(@_));
 332    }
 333    @_
 334  }
 335
 336 Note that the function returns it's arguments.  This can be used in a number of
 337 ways, but often it's convenient just for partial inspection of passthrough data
 338
 339  my @friends = log_trace {
 340    'friends list being generated, data from first friend: ' .
 341      Dumper($_[0]->TO_JSON)
 342  } generate_friend_list();
 343
 344 If you want complete inspection of passthrough data, take a look at the
 345 L</Dlog_$level> functions.
 346
 347 =head3 log_trace
 348
 349  log_trace { 'entered method foo with args ' join q{,}, @args };
 350
 351 =head3 log_debug
 352
 353  log_debug { 'entered method foo' };
 354
 355 =head3 log_info
 356
 357  log_info { 'started process foo' };
 358
 359 =head3 log_warn
 360
 361  log_warn { 'possible misconfiguration at line 10' };
 362
 363 =head3 log_error
 364
 365  log_error { 'non-numeric user input!' };
 366
 367 =head3 log_fatal
 368
 369  log_fatal { '1 is never equal to 0!' };
 370
 371 =head2 logS_$level
 372
 373 Import Tag: C<:log>
 374
 375 Arguments: C<CodeRef $returning_message, Item $arg>
 376
 377 This is really just a special case of the L</log_$level> functions.  It forces
 378 scalar context when that is what you need.  Other than that it works exactly
 379 same:
 380
 381  my $friend = logS_trace {
 382    'I only have one friend: ' .  Dumper($_[0]->TO_JSON)
 383  } friend();
 384
 385 See also: L</DlogS_$level>.
 386
 387 =head2 Dlog_$level
 388
 389 Import Tag: C<:dlog>
 390
 391 Arguments: C<CodeRef $returning_message, @args>
 392
 393 All of the following six functions work the same as their L</log_$level>
 394 brethren, except they return what is passed into them and put the stringified
 395 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 396 you can do cool things like the following:
 397
 398  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 399
 400 and the output might look something like:
 401
 402  names: "fREW"
 403  "fRIOUX"
 404  "fROOH"
 405  "fRUE"
 406  "fiSMBoC"
 407
 408 =head3 Dlog_trace
 409
 410  my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
 411
 412 =head3 Dlog_debug
 413
 414  Dlog_debug { "random data structure: $_" } { foo => $bar };
 415
 416 =head3 Dlog_info
 417
 418  return Dlog_info { "html from method returned: $_" } "<html>...</html>";
 419
 420 =head3 Dlog_warn
 421
 422  Dlog_warn { "probably invalid value: $_" } $foo;
 423
 424 =head3 Dlog_error
 425
 426  Dlog_error { "non-numeric user input! ($_)" } $port;
 427
 428 =head3 Dlog_fatal
 429
 430  Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 431
 432 =head2 DlogS_$level
 433
 434 Import Tag: C<:dlog>
 435
 436 Arguments: C<CodeRef $returning_message, Item $arg>
 437
 438 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
 439 They only take a single scalar after the C<$returning_message> instead of
 440 slurping up (and also setting C<wantarray>) all the C<@args>
 441
 442  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 443    $schema->resultset('Pals')->search({ perlers => 1 });
 444
 445 =head1 LOGGER INTERFACE
 446
 447 Because this module is ultimately pretty looking glue (glittery?) with the
 448 awesome benefit of the Contextual part, users will often want to make their
 449 favorite logger work with it.  The following are the methods that should be
 450 implemented in the logger:
 451
 452  is_trace
 453  is_debug
 454  is_info
 455  is_warn
 456  is_error
 457  is_fatal
 458  trace
 459  debug
 460  info
 461  warn
 462  error
 463  fatal
 464
 465 The first six merely need to return true if that level is enabled.  The latter
 466 six take the results of whatever the user returned from their coderef and log
 467 them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 468
 469 =head1 AUTHOR
 470
 471 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 472
 473 =head1 DESIGNER
 474
 475 mst - Matt S. Trout <mst@shadowcat.co.uk>
 476
 477 =head1 COPYRIGHT
 478
 479 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 480 above.
 481
 482 =head1 LICENSE
 483
 484 This library is free software and may be distributed under the same terms as
 485 Perl 5 itself.
 486
 487 =cut
 488