lib/Log/Contextual.pm

   1 package Log::Contextual;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.004100';
   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
 198    my $minilogger = Log::Contextual::SimpleLogger->new({
 199      levels => [qw( trace debug )]
 200    });
 201
 202    with_logger $minilogger => sub {
 203      log_trace { 'foo entered' };
 204      my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
 205      # ...
 206      log_trace { 'foo left' };
 207    };
 208  }
 209
 210  foo();
 211
 212 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
 213 with C<Log::Contextual>:
 214
 215  use Log::Contextual qw( :log :dlog set_logger );
 216  use Log::Dispatchouli;
 217  my $ld = Log::Dispatchouli->new({
 218     ident     => 'slrtbrfst',
 219     to_stderr => 1,
 220     debug     => 1,
 221  });
 222
 223  set_logger $ld;
 224
 225  log_debug { 'program started' };
 226
 227 =head1 DESCRIPTION
 228
 229 This module is a simple interface to extensible logging.  It is bundled with a
 230 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
 231 should use a real logger instead of that.  For something more serious but not
 232 overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
 233
 234 The reason for this module is to abstract your logging interface so that
 235 logging is as painless as possible, while still allowing you to switch from one
 236 logger to another.
 237
 238 =head1 A WORK IN PROGRESS
 239
 240 This module is certainly not complete, but we will not break the interface
 241 lightly, so I would say it's safe to use in production code.  The main result
 242 from that at this point is that doing:
 243
 244  use Log::Contextual;
 245
 246 will die as we do not yet know what the defaults should be.  If it turns out
 247 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
 248 probably make C<:log> the default.  But only time and usage will tell.
 249
 250 =head1 IMPORT OPTIONS
 251
 252 See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
 253 wide.
 254
 255 =head2 -logger
 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 =head2 -levels
 272
 273 The C<-levels> import option allows you to define exactly which levels your
 274 logger supports.  So the default,
 275 C<< [qw(debug trace warn info error fatal)] >>, works great for
 276 L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>.  But
 277 supporting those levels is as easy as doing
 278
 279  use Log::Contextual
 280    -levels => [qw( debug info notice warning error critical alert emergency )];
 281
 282 =head2 -package_logger
 283
 284 The C<-package_logger> import option is similar to the C<-logger> import option
 285 except C<-package_logger> sets the the logger for the current package.
 286
 287 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
 288 L</set_logger>.
 289
 290  package My::Package;
 291  use Log::Contextual::SimpleLogger;
 292  use Log::Contextual qw( :log ),
 293    -package_logger => Log::Contextual::WarnLogger->new({
 294       env_prefix => 'MY_PACKAGE'
 295    });
 296
 297 If you are interested in using this package for a module you are putting on
 298 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
 299
 300 =head2 -default_logger
 301
 302 The C<-default_logger> import option is similar to the C<-logger> import option
 303 except C<-default_logger> sets the the B<default> logger for the current package.
 304
 305 Basically it sets the logger to be used if C<set_logger> is never called; so
 306
 307  package My::Package;
 308  use Log::Contextual::SimpleLogger;
 309  use Log::Contextual qw( :log ),
 310    -default_logger => Log::Contextual::WarnLogger->new({
 311       env_prefix => 'MY_PACKAGE'
 312    });
 313
 314 =head1 SETTING DEFAULT IMPORT OPTIONS
 315
 316 Eventually you will get tired of writing the following in every single one of
 317 your packages:
 318
 319  use Log::Log4perl;
 320  use Log::Log4perl ':easy';
 321  BEGIN { Log::Log4perl->easy_init($DEBUG) }
 322
 323  use Log::Contextual -logger => Log::Log4perl->get_logger;
 324
 325 You can set any of the import options for your whole project if you define your
 326 own C<Log::Contextual> subclass as follows:
 327
 328  package MyApp::Log::Contextual;
 329
 330  use base 'Log::Contextual';
 331
 332  use Log::Log4perl ':easy';
 333  Log::Log4perl->easy_init($DEBUG)
 334
 335  sub arg_logger { $_[1] || Log::Log4perl->get_logger }
 336  sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
 337
 338  # and *maybe* even these:
 339  sub arg_package_logger { $_[1] }
 340  sub arg_default_logger { $_[1] }
 341
 342 Note the C<< $_[1] || >> in C<arg_logger>.  All of these methods are passed the
 343 values passed in from the arguments to the subclass, so you can either throw
 344 them away, honor them, die on usage, or whatever.  To be clear, if you define
 345 your subclass, and someone uses it as follows:
 346
 347  use MyApp::Log::Contextual -logger => $foo, -levels => [qw(bar baz biff)];
 348
 349 Your C<arg_logger> method will get C<$foo> and your C<arg_levels>
 350 will get C<[qw(bar baz biff)]>;
 351
 352 =head1 FUNCTIONS
 353
 354 =head2 set_logger
 355
 356  my $logger = WarnLogger->new;
 357  set_logger $logger;
 358
 359 Arguments: C<Ref|CodeRef $returning_logger>
 360
 361 C<set_logger> will just set the current logger to whatever you pass it.  It
 362 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
 363 C<CodeRef> for you.  C<set_logger> is really meant only to be called from a
 364 top-level script.  To avoid foot-shooting the function will warn if you call it
 365 more than once.
 366
 367 =head2 with_logger
 368
 369  my $logger = WarnLogger->new;
 370  with_logger $logger => sub {
 371     if (1 == 0) {
 372        log_fatal { 'Non Logical Universe Detected' };
 373     } else {
 374        log_info  { 'All is good' };
 375     }
 376  };
 377
 378 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
 379
 380 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
 381 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
 382 C<CodeRef> if needed.
 383
 384 =head2 log_$level
 385
 386 Import Tag: C<:log>
 387
 388 Arguments: C<CodeRef $returning_message, @args>
 389
 390 All of the following six functions work the same except that a different method
 391 is called on the underlying C<$logger> object.  The basic pattern is:
 392
 393  sub log_$level (&@) {
 394    if ($logger->is_$level) {
 395      $logger->$level(shift->(@_));
 396    }
 397    @_
 398  }
 399
 400 Note that the function returns it's arguments.  This can be used in a number of
 401 ways, but often it's convenient just for partial inspection of passthrough data
 402
 403  my @friends = log_trace {
 404    'friends list being generated, data from first friend: ' .
 405      Dumper($_[0]->TO_JSON)
 406  } generate_friend_list();
 407
 408 If you want complete inspection of passthrough data, take a look at the
 409 L</Dlog_$level> functions.
 410
 411 =head3 log_trace
 412
 413  log_trace { 'entered method foo with args ' join q{,}, @args };
 414
 415 =head3 log_debug
 416
 417  log_debug { 'entered method foo' };
 418
 419 =head3 log_info
 420
 421  log_info { 'started process foo' };
 422
 423 =head3 log_warn
 424
 425  log_warn { 'possible misconfiguration at line 10' };
 426
 427 =head3 log_error
 428
 429  log_error { 'non-numeric user input!' };
 430
 431 =head3 log_fatal
 432
 433  log_fatal { '1 is never equal to 0!' };
 434
 435 =head2 logS_$level
 436
 437 Import Tag: C<:log>
 438
 439 Arguments: C<CodeRef $returning_message, Item $arg>
 440
 441 This is really just a special case of the L</log_$level> functions.  It forces
 442 scalar context when that is what you need.  Other than that it works exactly
 443 same:
 444
 445  my $friend = logS_trace {
 446    'I only have one friend: ' .  Dumper($_[0]->TO_JSON)
 447  } friend();
 448
 449 See also: L</DlogS_$level>.
 450
 451 =head2 Dlog_$level
 452
 453 Import Tag: C<:dlog>
 454
 455 Arguments: C<CodeRef $returning_message, @args>
 456
 457 All of the following six functions work the same as their L</log_$level>
 458 brethren, except they return what is passed into them and put the stringified
 459 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 460 you can do cool things like the following:
 461
 462  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 463
 464 and the output might look something like:
 465
 466  names: "fREW"
 467  "fRIOUX"
 468  "fROOH"
 469  "fRUE"
 470  "fiSMBoC"
 471
 472 =head3 Dlog_trace
 473
 474  my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
 475
 476 =head3 Dlog_debug
 477
 478  Dlog_debug { "random data structure: $_" } { foo => $bar };
 479
 480 =head3 Dlog_info
 481
 482  return Dlog_info { "html from method returned: $_" } "<html>...</html>";
 483
 484 =head3 Dlog_warn
 485
 486  Dlog_warn { "probably invalid value: $_" } $foo;
 487
 488 =head3 Dlog_error
 489
 490  Dlog_error { "non-numeric user input! ($_)" } $port;
 491
 492 =head3 Dlog_fatal
 493
 494  Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
 495
 496 =head2 DlogS_$level
 497
 498 Import Tag: C<:dlog>
 499
 500 Arguments: C<CodeRef $returning_message, Item $arg>
 501
 502 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
 503 They only take a single scalar after the C<$returning_message> instead of
 504 slurping up (and also setting C<wantarray>) all the C<@args>
 505
 506  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 507    $schema->resultset('Pals')->search({ perlers => 1 });
 508
 509 =head1 LOGGER INTERFACE
 510
 511 Because this module is ultimately pretty looking glue (glittery?) with the
 512 awesome benefit of the Contextual part, users will often want to make their
 513 favorite logger work with it.  The following are the methods that should be
 514 implemented in the logger:
 515
 516  is_trace
 517  is_debug
 518  is_info
 519  is_warn
 520  is_error
 521  is_fatal
 522  trace
 523  debug
 524  info
 525  warn
 526  error
 527  fatal
 528
 529 The first six merely need to return true if that level is enabled.  The latter
 530 six take the results of whatever the user returned from their coderef and log
 531 them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 532
 533 =head1 AUTHOR
 534
 535 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 536
 537 =head1 DESIGNER
 538
 539 mst - Matt S. Trout <mst@shadowcat.co.uk>
 540
 541 =head1 COPYRIGHT
 542
 543 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 544 above.
 545
 546 =head1 LICENSE
 547
 548 This library is free software and may be distributed under the same terms as
 549 Perl 5 itself.
 550
 551 =cut
 552