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_default_logger { $_[1] || Log::Log4perl->get_logger }
 336  sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
 337
 338  # or maybe instead of default_logger
 339  sub arg_package_logger { $_[1] }
 340
 341  # and almost definitely not this, which is only here for completeness
 342  sub arg_logger { $_[1] }
 343
 344 Note the C<< $_[1] || >> in C<arg_default_logger>.  All of these methods are
 345 passed the values passed in from the arguments to the subclass, so you can
 346 either throw them away, honor them, die on usage, or whatever.  To be clear,
 347 if you define your subclass, and someone uses it as follows:
 348
 349  use MyApp::Log::Contextual -default_logger => $foo,
 350                             -levels => [qw(bar baz biff)];
 351
 352 Your C<arg_default_logger> method will get C<$foo> and your C<arg_levels>
 353 will get C<[qw(bar baz biff)]>;
 354
 355 =head1 FUNCTIONS
 356
 357 =head2 set_logger
 358
 359  my $logger = WarnLogger->new;
 360  set_logger $logger;
 361
 362 Arguments: C<Ref|CodeRef $returning_logger>
 363
 364 C<set_logger> will just set the current logger to whatever you pass it.  It
 365 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
 366 C<CodeRef> for you.  C<set_logger> is really meant only to be called from a
 367 top-level script.  To avoid foot-shooting the function will warn if you call it
 368 more than once.
 369
 370 =head2 with_logger
 371
 372  my $logger = WarnLogger->new;
 373  with_logger $logger => sub {
 374     if (1 == 0) {
 375        log_fatal { 'Non Logical Universe Detected' };
 376     } else {
 377        log_info  { 'All is good' };
 378     }
 379  };
 380
 381 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
 382
 383 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
 384 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
 385 C<CodeRef> if needed.
 386
 387 =head2 log_$level
 388
 389 Import Tag: C<:log>
 390
 391 Arguments: C<CodeRef $returning_message, @args>
 392
 393 C<log_$level> functions all work the same except that a different method
 394 is called on the underlying C<$logger> object.  The basic pattern is:
 395
 396  sub log_$level (&@) {
 397    if ($logger->is_$level) {
 398      $logger->$level(shift->(@_));
 399    }
 400    @_
 401  }
 402
 403 Note that the function returns it's arguments.  This can be used in a number of
 404 ways, but often it's convenient just for partial inspection of passthrough data
 405
 406  my @friends = log_trace {
 407    'friends list being generated, data from first friend: ' .
 408      Dumper($_[0]->TO_JSON)
 409  } generate_friend_list();
 410
 411 If you want complete inspection of passthrough data, take a look at the
 412 L</Dlog_$level> functions.
 413
 414 Which functions are exported depends on what was passed to L</-levels>.  The
 415 default (no C<-levels> option passed) would export:
 416
 417 =over 2
 418
 419 =item log_trace
 420
 421 =item log_debug
 422
 423 =item log_info
 424
 425 =item log_warn
 426
 427 =item log_error
 428
 429 =item log_fatal
 430
 431 =back
 432
 433 =head2 logS_$level
 434
 435 Import Tag: C<:log>
 436
 437 Arguments: C<CodeRef $returning_message, Item $arg>
 438
 439 This is really just a special case of the L</log_$level> functions.  It forces
 440 scalar context when that is what you need.  Other than that it works exactly
 441 same:
 442
 443  my $friend = logS_trace {
 444    'I only have one friend: ' .  Dumper($_[0]->TO_JSON)
 445  } friend();
 446
 447 See also: L</DlogS_$level>.
 448
 449 =head2 Dlog_$level
 450
 451 Import Tag: C<:dlog>
 452
 453 Arguments: C<CodeRef $returning_message, @args>
 454
 455 All of the following six functions work the same as their L</log_$level>
 456 brethren, except they return what is passed into them and put the stringified
 457 (with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
 458 you can do cool things like the following:
 459
 460  my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
 461
 462 and the output might look something like:
 463
 464  names: "fREW"
 465  "fRIOUX"
 466  "fROOH"
 467  "fRUE"
 468  "fiSMBoC"
 469
 470 Which functions are exported depends on what was passed to L</-levels>.  The
 471 default (no C<-levels> option passed) would export:
 472
 473 =over 2
 474
 475 =item Dlog_trace
 476
 477 =item Dlog_debug
 478
 479 =item Dlog_info
 480
 481 =item Dlog_warn
 482
 483 =item Dlog_error
 484
 485 =item Dlog_fatal
 486
 487 =back
 488
 489 =head2 DlogS_$level
 490
 491 Import Tag: C<:dlog>
 492
 493 Arguments: C<CodeRef $returning_message, Item $arg>
 494
 495 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
 496 They only take a single scalar after the C<$returning_message> instead of
 497 slurping up (and also setting C<wantarray>) all the C<@args>
 498
 499  my $pals_rs = DlogS_debug { "pals resultset: $_" }
 500    $schema->resultset('Pals')->search({ perlers => 1 });
 501
 502 =head1 LOGGER INTERFACE
 503
 504 Because this module is ultimately pretty looking glue (glittery?) with the
 505 awesome benefit of the Contextual part, users will often want to make their
 506 favorite logger work with it.  The following are the methods that should be
 507 implemented in the logger:
 508
 509  is_trace
 510  is_debug
 511  is_info
 512  is_warn
 513  is_error
 514  is_fatal
 515  trace
 516  debug
 517  info
 518  warn
 519  error
 520  fatal
 521
 522 The first six merely need to return true if that level is enabled.  The latter
 523 six take the results of whatever the user returned from their coderef and log
 524 them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 525
 526 =head1 AUTHOR
 527
 528 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
 529
 530 =head1 DESIGNER
 531
 532 mst - Matt S. Trout <mst@shadowcat.co.uk>
 533
 534 =head1 COPYRIGHT
 535
 536 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 537 above.
 538
 539 =head1 LICENSE
 540
 541 This library is free software and may be distributed under the same terms as
 542 Perl 5 itself.
 543
 544 =cut
 545