From: Arthur Axel 'fREW' Schmidt <frioux@gmail.com>
Date: Wed, 3 Oct 2012 22:16:54 +0000 (-0500)
Subject: add a way to set default import options
X-Git-Tag: v0.004300~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8ee5c30393ba3f9061290639fe78f4c6111acbea;p=p5sagit%2FLog-Contextual.git

add a way to set default import options
---

diff --git a/Changes b/Changes
index b26bb3a..2d5e224 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 ChangeLog for Log-Contextual
 
+  - add a way to set default import options
+
 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 1d0a1dc..a8ce495 100644
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -38,9 +38,16 @@ import_arguments qw(logger package_logger default_logger);
 sub before_import {
    my ($class, $importer, $spec) = @_;
 
-   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;
+   }
+
    my @levels = @{$class->arg_levels($spec->config->{levels})};
    for my $level (@levels) {
       if ($spec->config->{log}) {
@@ -70,6 +77,14 @@ sub before_import {
    }
 }
 
+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] }
@@ -374,6 +389,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] }
@@ -392,6 +408,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
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
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;