integrate default import tag api from 0.004300

diff --git a/Changes b/Changes
index 4969303..08ed302 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 ChangeLog for Log-Contextual
 
+  - merge unpushed 0.004300 into master (frew--, Tyler Riddle++)
+
 0.005000_02 2013-01-15
  - add missing changelog entry (derp)
 
@@ -10,6 +12,9 @@ ChangeLog for Log-Contextual
     something like that) and changing their logger.  See the new
     Log::Contextual::Role::Router for more information
 
+0.004300 2012-10-03
+  - add a way to set default import tags
+
 0.004202 2012-08-04
   - correct the caller_level passed into coderef, and document "both" uses of
     caller_level

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index afa70fd..9992822 100644 (file)
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -36,6 +36,14 @@ sub router {
      }
 }
 
+sub default_import {
+   my ($class) = shift;
+
+   die 'Log::Contextual does not have a default import list';
+
+   ()
+}
+
 sub arg_logger         { $_[1] }
 sub arg_levels         { $_[1] || [qw(debug trace warn info error fatal)] }
 sub arg_package_logger { $_[1] }
@@ -51,9 +59,16 @@ sub before_import {
       arguments => $spec->argument_info
    );
 
-   die 'Log::Contextual does not have a default import list'
+   my @tags = $class->default_import($spec)
      if $spec->config->{default};
 
+   for (@tags) {
+      die "only tags are supported for defaults at this time"
+        unless $_ =~ /^:(.*)$/;
+
+      $spec->config->{$1} = 1;
+   }
+
    $router->before_import(%router_args);
 
    if ($exports->{'&set_logger'}) {
@@ -358,6 +373,7 @@ own C<Log::Contextual> subclass as follows:
 
  sub arg_default_logger { $_[1] || Log::Log4perl->get_logger }
  sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
+ sub default_import { ':log' }
 
  # or maybe instead of default_logger
  sub arg_package_logger { $_[1] }
@@ -376,6 +392,17 @@ if you define your subclass, and someone uses it as follows:
 Your C<arg_default_logger> method will get C<$foo> and your C<arg_levels>
 will get C<[qw(bar baz biff)]>;
 
+Additionally, the C<default_import> method is what happens if a user tries to
+use your subclass with no arguments.  The default just dies, but if you'd like
+to change the default to import a tag merely return the tags you'd like to
+import.  So the following will all work:
+
+ sub default_import { ':log' }
+
+ sub default_import { ':dlog' }
+
+ sub default_import { qw(:dlog :log ) }
+
 =head1 FUNCTIONS
 
 =head2 set_logger

diff --git a/t/default_import.t b/t/default_import.t
new file mode 100644 (file)
index 0000000..a7cb27c
--- /dev/null
+++ b/t/default_import.t
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use DefaultImportLogger;
+use Test::More qw(no_plan);
+
+my @levels = qw(lol wut zomg);
+
+VANILLA: {
+   for (@levels) {
+      main->can("log_$_")->(sub { 'fiSMBoC' });
+      is( $DumbLogger2::var, "[$_] fiSMBoC\n", "$_ works");
+
+      my @vars = main->can("log_$_")->(sub { 'fiSMBoC: ' . $_[1] }, qw{foo bar baz});
+      is( $DumbLogger2::var, "[$_] fiSMBoC: bar\n", "log_$_ works with input");
+      ok( eq_array(\@vars, [qw{foo bar baz}]), "log_$_ passes data through correctly");
+
+      my $val = main->can("logS_$_")->(sub { 'fiSMBoC: ' . $_[0] }, 'foo');
+      is( $DumbLogger2::var, "[$_] fiSMBoC: foo\n", "logS_$_ works with input");
+      is( $val, 'foo', "logS_$_ passes data through correctly");
+   }
+}
+

diff --git a/t/lib/DefaultImportLogger.pm b/t/lib/DefaultImportLogger.pm
new file mode 100644 (file)
index 0000000..314c5fc
--- /dev/null
+++ b/t/lib/DefaultImportLogger.pm
@@ -0,0 +1,23 @@
+package DefaultImportLogger;
+
+use base 'Log::Contextual';
+use Log::Contextual::SimpleLogger;
+
+my $logger = DumbLogger2->new;
+
+sub default_import { ':log' }
+sub arg_levels { $_[1] || [qw(lol wut zomg)] }
+sub arg_logger { $_[1] || $logger }
+
+package DumbLogger2;
+
+our $var;
+sub new { bless {}, 'DumbLogger2' }
+sub is_wut { 1 }
+sub wut { $var = "[wut] $_[1]\n" }
+sub is_lol { 1 }
+sub lol { $var = "[lol] $_[1]\n" }
+sub is_zomg { 1 }
+sub zomg { $var = "[zomg] $_[1]\n" }
+
+1;