X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FLog%2FContextual.pm;h=fc0c0c1f9e6eb743e474ecf14fb1286d4cf50227;hb=9f4b10b229217daf3f58dd0ac0eb634c270da1e3;hp=e64c7781f09c3dcf13f3bd277208640bc8f2968f;hpb=70a0583043822305c068fe55010f712ff70d51ad;p=p5sagit%2FLog-Contextual.git

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index e64c778..fc0c0c1 100644
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -1,11 +1,9 @@
-# add example for Log::Dispatchouli
-
 package Log::Contextual;
 
 use strict;
 use warnings;
 
-our $VERSION = '0.00101';
+our $VERSION = '0.00300';
 
 require Exporter;
 use Data::Dumper::Concise;
@@ -52,6 +50,9 @@ sub import {
       if ( defined $val && $val eq '-logger' ) {
          set_logger($_[$idx + 1]);
          splice @_, $idx, 2;
+      } elsif ( defined $val && $val eq '-package_logger' ) {
+         _set_package_logger_for(scalar caller, $_[$idx + 1]);
+         splice @_, $idx, 2;
       } elsif ( defined $val && $val eq '-default_logger' ) {
          _set_default_logger_for(scalar caller, $_[$idx + 1]);
          splice @_, $idx, 2;
@@ -62,6 +63,7 @@ sub import {
 
 our $Get_Logger;
 our %Default_Logger;
+our %Package_Logger;
 
 sub _set_default_logger_for {
    my $logger = $_[1];
@@ -73,9 +75,20 @@ sub _set_default_logger_for {
    $Default_Logger{$_[0]} = $logger
 }
 
+sub _set_package_logger_for {
+   my $logger = $_[1];
+   if(ref $logger ne 'CODE') {
+      die 'logger was not a CodeRef or a logger object.  Please try again.'
+         unless blessed($logger);
+      $logger = do { my $l = $logger; sub { $l } }
+   }
+   $Package_Logger{$_[0]} = $logger
+}
+
 sub _get_logger($) {
    my $package = shift;
    (
+      $Package_Logger{$package} ||
       $Get_Logger ||
       $Default_Logger{$package} ||
       die q( no logger set!  you can't try to log something without a logger! )
@@ -106,245 +119,110 @@ sub with_logger {
    $_[1]->();
 }
 
+sub _do_log {
+   my $level  = shift;
+   my $logger = shift;
+   my $code   = shift;
+   my @values = @_;
 
-
-sub log_trace (&@) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->trace($code->(@_))
-      if $log->is_trace;
-   @_
-}
-
-sub log_debug (&@) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->debug($code->(@_))
-      if $log->is_debug;
-   @_
-}
-
-sub log_info (&@) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->info($code->(@_))
-      if $log->is_info;
-   @_
-}
-
-sub log_warn (&@) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->warn($code->(@_))
-      if $log->is_warn;
-   @_
-}
-
-sub log_error (&@) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->error($code->(@_))
-      if $log->is_error;
-   @_
-}
-
-sub log_fatal (&@) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->fatal($code->(@_))
-      if $log->is_fatal;
-   @_
-}
-
-
-sub logS_trace (&$) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   my $value = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->trace($code->($value))
-      if $log->is_trace;
-   $value
+   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 2;
+   $logger->$level($code->(@_))
+      if $logger->${\"is_$level"};
+   @values
 }
 
-sub logS_debug (&$) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   my $value = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->debug($code->($value))
-      if $log->is_debug;
-   $value
-}
+sub _do_logS {
+   my $level  = shift;
+   my $logger = shift;
+   my $code   = shift;
+   my $value  = shift;
 
-sub logS_info (&$) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   my $value = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->info($code->($value))
-      if $log->is_info;
+   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 2;
+   $logger->$level($code->($value))
+      if $logger->${\"is_$level"};
    $value
 }
 
-sub logS_warn (&$) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   my $value = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->warn($code->($value))
-      if $log->is_warn;
-   $value
-}
-
-sub logS_error (&$) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   my $value = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->error($code->($value))
-      if $log->is_error;
-   $value
-}
-
-sub logS_fatal (&$) {
-   my $log  = _get_logger( caller );
-   my $code = shift;
-   my $value = shift;
-   local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
-   $log->fatal($code->($value))
-      if $log->is_fatal;
-   $value
-}
+sub log_trace (&@) { _do_log( trace => _get_logger( caller ), shift @_, @_) }
+sub log_debug (&@) { _do_log( debug => _get_logger( caller ), shift @_, @_) }
+sub log_info  (&@) { _do_log( info  => _get_logger( caller ), shift @_, @_) }
+sub log_warn  (&@) { _do_log( warn  => _get_logger( caller ), shift @_, @_) }
+sub log_error (&@) { _do_log( error => _get_logger( caller ), shift @_, @_) }
+sub log_fatal (&@) { _do_log( fatal => _get_logger( caller ), shift @_, @_) }
 
+sub logS_trace (&$) { _do_logS( trace => _get_logger( caller ), $_[0], $_[1]) }
+sub logS_debug (&$) { _do_logS( debug => _get_logger( caller ), $_[0], $_[1]) }
+sub logS_info  (&$) { _do_logS( info  => _get_logger( caller ), $_[0], $_[1]) }
+sub logS_warn  (&$) { _do_logS( warn  => _get_logger( caller ), $_[0], $_[1]) }
+sub logS_error (&$) { _do_logS( error => _get_logger( caller ), $_[0], $_[1]) }
+sub logS_fatal (&$) { _do_logS( fatal => _get_logger( caller ), $_[0], $_[1]) }
 
 
 sub Dlog_trace (&@) {
   my $code = shift;
-  my @values = @_;
-  return log_trace {
-     if (@values) {
-        do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-     } else {
-        do { local $_ = '()'; $code->() };
-     }
-  } @values
+  local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+  return _do_log( trace => _get_logger( caller ), $code, @_ );
 }
 
 sub Dlog_debug (&@) {
   my $code = shift;
-  my @values = @_;
-  log_debug {
-     if (@values) {
-        do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-     } else {
-        do { local $_ = '()'; $code->() };
-     }
-  } @values
+  local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+  return _do_log( debug => _get_logger( caller ), $code, @_ );
 }
 
 sub Dlog_info (&@) {
   my $code = shift;
-  my @values = @_;
-  log_info {
-     if (@values) {
-        do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-     } else {
-        do { local $_ = '()'; $code->() };
-     }
-  } @values
+  local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+  return _do_log( info => _get_logger( caller ), $code, @_ );
 }
 
 sub Dlog_warn (&@) {
   my $code = shift;
-  my @values = @_;
-  log_warn {
-     if (@values) {
-        do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-     } else {
-        do { local $_ = '()'; $code->() };
-     }
-  } @values
+  local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+  return _do_log( warn => _get_logger( caller ), $code, @_ );
 }
 
 sub Dlog_error (&@) {
   my $code = shift;
-  my @values = @_;
-  log_error {
-     if (@values) {
-        do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-     } else {
-        do { local $_ = '()'; $code->() };
-     }
-  } @values
+  local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+  return _do_log( error => _get_logger( caller ), $code, @_ );
 }
 
 sub Dlog_fatal (&@) {
   my $code = shift;
-  my @values = @_;
-  log_fatal {
-     if (@values) {
-        do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-     } else {
-        do { local $_ = '()'; $code->() };
-     }
-  } @values
+  local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+  return _do_log( fatal => _get_logger( caller ), $code, @_ );
 }
 
 
-
 sub DlogS_trace (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  logS_trace {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  } $value
+  local $_ = Data::Dumper::Concise::Dumper $_[1];
+  _do_logS( trace => _get_logger( caller ), $_[0], $_[1] )
 }
 
 sub DlogS_debug (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  logS_debug {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  } $value
+  local $_ = Data::Dumper::Concise::Dumper $_[1];
+  _do_logS( debug => _get_logger( caller ), $_[0], $_[1] )
 }
 
 sub DlogS_info (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  logS_info {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  } $value
+  local $_ = Data::Dumper::Concise::Dumper $_[1];
+  _do_logS( info => _get_logger( caller ), $_[0], $_[1] )
 }
 
 sub DlogS_warn (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  logS_warn {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  } $value
+  local $_ = Data::Dumper::Concise::Dumper $_[1];
+  _do_logS( warn => _get_logger( caller ), $_[0], $_[1] )
 }
 
 sub DlogS_error (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  logS_error {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  } $value
+  local $_ = Data::Dumper::Concise::Dumper $_[1];
+  _do_logS( error => _get_logger( caller ), $_[0], $_[1] )
 }
 
 sub DlogS_fatal (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  logS_fatal {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  } $value
+  local $_ = Data::Dumper::Concise::Dumper $_[1];
+  _do_logS( fatal => _get_logger( caller ), $_[0], $_[1] )
 }
 
 1;
@@ -382,12 +260,27 @@ Log::Contextual - Simple logging interface with a contextual log
 
  foo();
 
+Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
+with C<Log::Contextual>:
+
+ use Log::Contextual qw( :log :dlog set_logger );
+ use Log::Dispatchouli;
+ my $ld = Log::Dispatchouli->new({
+    ident     => 'slrtbrfst',
+    to_stderr => 1,
+    debug     => 1,
+ });
+
+ set_logger $ld;
+
+ log_debug { 'program started' };
+
 =head1 DESCRIPTION
 
 This module is a simple interface to extensible logging.  It is bundled with a
 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
 should use a real logger instead of that.  For something more serious but not
-overly complicated, take a look at L<Log::Dispatchouli>.
+overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
 
 =head1 OPTIONS
 
@@ -407,10 +300,28 @@ case you might try something like the following:
  BEGIN { $var_log = VarLogger->new }
  use Log::Contextual qw( :dlog ), -logger => $var_log;
 
+=head2 -package_logger
+
+The C<-package_logger> import option is similar to the C<-logger> import option
+except C<-package_logger> sets the the logger for the current package.
+
+Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
+L</set_logger>.
+
+ package My::Package;
+ use Log::Contextual::SimpleLogger;
+ use Log::Contextual qw( :log ),
+   -package_logger => Log::Contextual::WarnLogger->new({
+      env_prefix => 'MY_PACKAGE'
+   });
+
+If you are interested in using this package for a module you are putting on
+CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
+
 =head2 -default_logger
 
 The C<-default_logger> import option is similar to the C<-logger> import option
-except C<-default_logger> sets the the default logger for the current package.
+except C<-default_logger> sets the the B<default> logger for the current package.
 
 Basically it sets the logger to be used if C<set_logger> is never called; so
 
@@ -421,9 +332,6 @@ Basically it sets the logger to be used if C<set_logger> is never called; so
       env_prefix => 'MY_PACKAGE'
    });
 
-If you are interested in using this package for a module you are putting on
-CPAN we recommend L<Log::Contextual::WarnLogger> for your default logger.
-
 =head1 A WORK IN PROGRESS
 
 This module is certainly not complete, but we will not break the interface