Add -package_logger

diff --git a/Changes b/Changes
index f89ba95..0f24843 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 ChangeLog for Log-Contextual
 
+0.00300 2010-06-03
+  - Add -package_logger import option
+
 0.00202 2010-05-23
   - Fix a bug that caused Dlog and friends not to work with a default
 

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index 3d338c2..98398ec 100644 (file)
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -50,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;
@@ -60,6 +63,7 @@ sub import {
 
 our $Get_Logger;
 our %Default_Logger;
+our %Package_Logger;
 
 sub _set_default_logger_for {
    my $logger = $_[1];
@@ -71,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! )
@@ -285,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
 
@@ -299,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

diff --git a/t/package_logger.t b/t/package_logger.t
new file mode 100644 (file)
index 0000000..796878d
--- /dev/null
+++ b/t/package_logger.t
@@ -0,0 +1,63 @@
+use strict;
+use warnings;
+
+use Log::Contextual qw{:log with_logger set_logger};
+use Log::Contextual::SimpleLogger;
+use Test::More qw(no_plan);
+my $var1;
+my $var2;
+my $var3;
+my $var_logger1 = Log::Contextual::SimpleLogger->new({
+   levels  => [qw(trace debug info warn error fatal)],
+   coderef => sub { $var1 = shift },
+});
+my $var_logger2;
+BEGIN {
+   $var_logger2 = Log::Contextual::SimpleLogger->new({
+      levels  => [qw(trace debug info warn error fatal)],
+      coderef => sub { $var2 = shift },
+   })
+}
+
+my $var_logger3;
+BEGIN {
+   $var_logger3 = Log::Contextual::SimpleLogger->new({
+      levels  => [qw(trace debug info warn error fatal)],
+      coderef => sub { $var3 = shift },
+   })
+}
+
+{
+   package J;
+   use Log::Contextual qw{:dlog :log with_logger set_logger}, -package_logger => $var_logger3;
+
+   sub foo {
+      log_debug { 'bar' };
+   }
+   sub bar {
+      Dlog_debug { "bar: $_" } 'frew';
+   }
+}
+
+{
+   package K;
+   use Log::Contextual qw{:log with_logger set_logger}, -package_logger => $var_logger2;
+
+   sub foo {
+      log_debug { 'foo' };
+   }
+}
+J::foo;
+K::foo;
+
+is($var2, "[debug] foo\n", 'package_logger works for one package');
+is($var3, "[debug] bar\n", 'package_logger works for both packages');
+J::bar;
+is($var3, qq([debug] bar: "frew"\n), 'package_logger works for one package');
+$var2 = '';
+$var1 = '';
+set_logger($var_logger1);
+
+K::foo;
+is($var1, q(), '... and set_logger does not win');
+is($var2, "[debug] foo\n", '... and package_logger still gets the value');