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