tests for -default_logger

[p5sagit/Log-Contextual.git] / lib / Log / Contextual.pm

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index 36fe2ad..596c155 100644 (file)
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -1,3 +1,8 @@
+# add example for Log::Dispatchouli
+#
+# make basic warn logger
+
+
 package Log::Contextual;
 
 use strict;
@@ -46,16 +51,39 @@ sub import {
       unless @_;
 
    for my $idx ( 0 .. $#_ ) {
-      if ( $_[$idx] eq '-logger' ) {
+      my $val = $_[$idx];
+      if ( defined $val && $val eq '-logger' ) {
          set_logger($_[$idx + 1]);
          splice @_, $idx, 2;
-         last;
+      } elsif ( defined $val && $val eq '-default_logger' ) {
+         _set_default_logger_for(scalar caller, $_[$idx + 1]);
+         splice @_, $idx, 2;
       }
    }
    $package->export_to_level(1, $package, @_);
 }
 
 our $Get_Logger;
+our %Default_Logger;
+
+sub _set_default_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 } }
+   }
+   $Default_Logger{$_[0]} = $logger
+}
+
+sub _get_logger($) {
+   my $package = shift;
+   (
+      $Get_Logger ||
+      $Default_Logger{$package} ||
+      die q( no logger set!  you can't try to log something without a logger! )
+   )->($package);
+}
 
 sub set_logger {
    my $logger = $_[0];
@@ -64,6 +92,9 @@ sub set_logger {
          unless blessed($logger);
       $logger = do { my $l = $logger; sub { $l } }
    }
+
+   warn 'set_logger (or -logger) called more than once!  This is a bad idea!'
+      if $Get_Logger;
    $Get_Logger = $logger;
 }
 
@@ -81,7 +112,7 @@ sub with_logger {
 
 
 sub log_trace (&@) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    $log->trace($code->(@_))
       if $log->is_trace;
@@ -89,7 +120,7 @@ sub log_trace (&@) {
 }
 
 sub log_debug (&@) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    $log->debug($code->(@_))
       if $log->is_debug;
@@ -97,7 +128,7 @@ sub log_debug (&@) {
 }
 
 sub log_info (&@) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    $log->info($code->(@_))
       if $log->is_info;
@@ -105,7 +136,7 @@ sub log_info (&@) {
 }
 
 sub log_warn (&@) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    $log->warn($code->(@_))
       if $log->is_warn;
@@ -113,7 +144,7 @@ sub log_warn (&@) {
 }
 
 sub log_error (&@) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    $log->error($code->(@_))
       if $log->is_error;
@@ -121,7 +152,7 @@ sub log_error (&@) {
 }
 
 sub log_fatal (&@) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    $log->fatal($code->(@_))
       if $log->is_fatal;
@@ -130,7 +161,7 @@ sub log_fatal (&@) {
 
 
 sub logS_trace (&$) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    my $value = shift;
    $log->trace($code->($value))
@@ -139,7 +170,7 @@ sub logS_trace (&$) {
 }
 
 sub logS_debug (&$) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    my $value = shift;
    $log->debug($code->($value))
@@ -148,7 +179,7 @@ sub logS_debug (&$) {
 }
 
 sub logS_info (&$) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    my $value = shift;
    $log->info($code->($value))
@@ -157,7 +188,7 @@ sub logS_info (&$) {
 }
 
 sub logS_warn (&$) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    my $value = shift;
    $log->warn($code->($value))
@@ -166,7 +197,7 @@ sub logS_warn (&$) {
 }
 
 sub logS_error (&$) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    my $value = shift;
    $log->error($code->($value))
@@ -175,7 +206,7 @@ sub logS_error (&$) {
 }
 
 sub logS_fatal (&$) {
-   my $log  = $Get_Logger->();
+   my $log  = _get_logger( caller );
    my $code = shift;
    my $value = shift;
    $log->fatal($code->($value))
@@ -388,7 +419,9 @@ Arguments: C<Ref|CodeRef $returning_logger>
 
 C<set_logger> will just set the current logger to whatever you pass it.  It
 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
-C<CodeRef> for you.
+C<CodeRef> for you.  C<set_logger> is really meant only to be called from a
+top-level script.  To avoid foot-shooting the function will warn if you call it
+more than once.
 
 =head2 with_logger