allow custom log levels

diff --git a/Changes b/Changes
index 7fbc261..8bb046d 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 ChangeLog for Log-Contextual
 
+  - Allow custom log levels
+
 0.00305 2011-07-27
   - Fix regression that caused D* subs to dumper even if the log level was off
 

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index 550baae..3e4e7ad 100644 (file)
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -22,13 +22,17 @@ eval {
    Log::Log4perl->wrapper_register(__PACKAGE__)
 };
 
-exports (
+# ____ is because tags must have at least one export and we don't want to
+# export anything but the levels selected
+sub ____ {}
+
+exports ('____',
    @dlog, @log,
    qw( set_logger with_logger )
 );
 
-export_tag dlog => @dlog;
-export_tag log  => @log;
+export_tag dlog => ('____');
+export_tag log  => ('____');
 import_arguments qw(logger package_logger default_logger);
 
 sub before_import {
@@ -37,10 +41,7 @@ sub before_import {
    die 'Log::Contextual does not have a default import list'
       if $spec->config->{default};
 
-   my @levels = qw(debug trace warn info error fatal);
-   if ( my $levels = $spec->config->{levels} ) {
-      @levels = @$levels
-   }
+   my @levels = @{$class->arg_levels($spec->config->{levels})};
    for my $level (@levels) {
       if ($spec->config->{log}) {
          $spec->add_export("&log_$level", sub (&@) {
@@ -69,17 +70,25 @@ sub before_import {
    }
 }
 
+sub arg_logger { $_[1] }
+sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
+sub arg_package_logger { $_[1] }
+sub arg_default_logger { $_[1] }
+
 sub after_import {
    my ($class, $importer, $specs) = @_;
 
-   set_logger( $specs->config->{logger} )
-      if $specs->config->{logger};
-   
-   _set_package_logger_for( $importer, $specs->config->{package_logger} )
-      if $specs->config->{package_logger};
+   if (my $l = $class->arg_logger($specs->config->{logger})) {
+      set_logger($l)
+   }
+
+   if (my $l = $class->arg_package_logger($specs->config->{package_logger})) {
+      _set_package_logger_for($importer, $l)
+   }
 
-   _set_default_logger_for( $importer, $specs->config->{default_logger} )
-      if $specs->config->{default_logger};
+   if (my $l = $class->arg_default_logger($specs->config->{default_logger})) {
+      _set_default_logger_for($importer, $l)
+   }
 }
 
 our $Get_Logger;
@@ -241,6 +250,17 @@ case you might try something like the following:
  BEGIN { $var_log = VarLogger->new }
  use Log::Contextual qw( :dlog ), -logger => $var_log;
 
+=head2 -levels
+
+The C<-levels> import option allows you to define exactly which levels your
+logger supports.  So the default,
+C<< [qw(debug trace warn info error fatal)] >>, works great for
+L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>.  But
+supporting those levels is as easy as doing
+
+ use Log::Contextual
+   -levels => [qw( debug info notice warning error critical alert emergency )];
+
 =head2 -package_logger
 
 The C<-package_logger> import option is similar to the C<-logger> import option

diff --git a/t/log-with-levels.t b/t/log-with-levels.t
new file mode 100644 (file)
index 0000000..4109750
--- /dev/null
+++ b/t/log-with-levels.t
@@ -0,0 +1,62 @@
+use strict;
+use warnings;
+
+use Log::Contextual qw{:dlog :log with_logger set_logger}, -levels => ['custom'];
+use Log::Contextual::SimpleLogger;
+use Test::More qw(no_plan);
+
+my $logger = DumbLogger->new;
+
+set_logger(sub { $logger });
+
+log_custom { 'fiSMBoC' };
+is( $DumbLogger::var, "fiSMBoC", "custom works");
+
+my @vars = log_custom { 'fiSMBoC: ' . $_[1] } qw{foo bar baz};
+is( $DumbLogger::var, "fiSMBoC: bar", "log_custom works with input");
+ok( eq_array(\@vars, [qw{foo bar baz}]), "log_custom passes data through correctly");
+
+my $val = logS_custom { 'fiSMBoC: ' . $_[0] } 'foo';
+is( $DumbLogger::var, "fiSMBoC: foo", "logS_custom works with input");
+is( $val, 'foo', "logS_custom passes data through correctly");
+
+my @foo = Dlog_custom { "Look ma, data: $_" } qw{frew bar baz};
+
+ok(
+   eq_array(\@foo, [qw{frew bar baz}]),
+   "Dlog_custom passes data through correctly"
+);
+is(
+   $DumbLogger::var, qq(Look ma, data: "frew"\n"bar"\n"baz"\n),
+   "Output for Dlog_custom is correct"
+);
+
+my $bar = DlogS_custom { "Look ma, data: $_" } [qw{frew bar baz}];
+ok(
+   eq_array($bar, [qw{frew bar baz}]),
+   'DlogS_custom passes data through correctly'
+);
+is(
+   $DumbLogger::var, qq(Look ma, data: [\n  "frew",\n  "bar",\n  "baz"\n]\n),
+   "Output for DlogS_custom is correct"
+);
+
+@foo = Dlog_custom { "nothing: $_" } ();
+ok( eq_array(\@foo, []), "Dlog_custom passes nothing through correctly");
+is( $DumbLogger::var, "nothing: ()", "Output for Dlog_custom is correct");
+
+ok(!main->can($_), "$_ not imported") 
+   for map +( "log_$_", "logS_$_" ), qw(debug trace warn info error fatal);
+
+ok(!eval { Log::Contextual->import; 1 }, 'Blank Log::Contextual import dies');
+
+BEGIN {
+   package DumbLogger;
+
+   our $var;
+   sub new { bless {}, 'DumbLogger' }
+   sub is_custom { 1 }
+   sub custom { $var = $_[1] }
+
+   1;
+}