release 0.005001 (FINALLY!)
[p5sagit/Log-Contextual.git] / lib / Log / Contextual.pm
index e2fa68f..4df4f46 100644 (file)
@@ -3,7 +3,8 @@ package Log::Contextual;
 use strict;
 use warnings;
 
-our $VERSION = '0.004202';
+our $VERSION = '0.005001';
+$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 my @levels = qw(debug trace warn info error fatal);
 
@@ -20,9 +21,9 @@ eval {
 
 # ____ is because tags must have at least one export and we don't want to
 # export anything but the levels selected
-sub ____ {}
+sub ____ { }
 
-exports (qw(____ set_logger with_logger ));
+exports(qw(____ set_logger with_logger ));
 
 export_tag dlog => ('____');
 export_tag log  => ('____');
@@ -32,95 +33,138 @@ sub router {
    our $Router_Instance ||= do {
       require Log::Contextual::Router;
       Log::Contextual::Router->new
-   }
+     }
+}
+
+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_logger         { $_[1] }
+sub arg_levels         { $_[1] || [qw(debug trace warn info error fatal)] }
 sub arg_package_logger { $_[1] }
 sub arg_default_logger { $_[1] }
 
 sub before_import {
    my ($class, $importer, $spec) = @_;
-   my $router = $class->router;
-   my $exports = $spec->exports;
-   my %router_args = (exporter => $class, target => $importer, arguments => $spec->argument_info);
-
-   die 'Log::Contextual does not have a default import list'
-      if $spec->config->{default};
+   my $router      = $class->router;
+   my $exports     = $spec->exports;
+   my %router_args = (
+      exporter  => $class,
+      target    => $importer,
+      arguments => $spec->argument_info
+   );
+
+   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);
 
-   $spec->add_export('&set_logger', sub {
-      my $router = $class->router;
-
+   if ($exports->{'&set_logger'}) {
       die ref($router) . " does not support set_logger()"
-         unless $router->does('Log::Contextual::Role::Router::SetLogger');
+        unless $router->does('Log::Contextual::Role::Router::SetLogger');
 
-      return $router->set_logger(@_);
-   }) if $exports->{'&set_logger'};
-
-   $spec->add_export('&with_logger', sub {
-      my $router = $class->router;
+      $spec->add_export('&set_logger', sub { $router->set_logger(@_) })
+   }
 
+   if ($exports->{'&with_logger'}) {
       die ref($router) . " does not support with_logger()"
-         unless $router->does('Log::Contextual::Role::Router::WithLogger');
+        unless $router->does('Log::Contextual::Role::Router::WithLogger');
 
-      return $router->with_logger(@_);
-   }) if $exports->{'&with_logger'};
+      $spec->add_export('&with_logger', sub { $router->with_logger(@_) })
+   }
 
    my @levels = @{$class->arg_levels($spec->config->{levels})};
    for my $level (@levels) {
       if ($spec->config->{log}) {
-         $spec->add_export("&log_$level", sub (&@) {
-            my ($code, @args) = @_;
-            $router->handle_log_request(
-               exporter => $class, caller_package => scalar(caller), caller_level => 1,
-               message_level => $level, message_sub => $code, message_args => \@args,
-            );
-            return @args;
-         });
-         $spec->add_export("&logS_$level", sub (&@) {
-            my ($code, @args) = @_;
-            $router->handle_log_request(
-               exporter => $class, caller_package => scalar(caller), caller_level => 1,
-               message_level => $level, message_sub => $code, message_args => \@args,
-            );
-            return $args[0];
-         });
+         $spec->add_export(
+            "&log_$level",
+            sub (&@) {
+               my ($code, @args) = @_;
+               $router->handle_log_request(
+                  exporter       => $class,
+                  caller_package => scalar(caller),
+                  caller_level   => 1,
+                  message_level  => $level,
+                  message_sub    => $code,
+                  message_args   => \@args,
+               );
+               return @args;
+            });
+         $spec->add_export(
+            "&logS_$level",
+            sub (&@) {
+               my ($code, @args) = @_;
+               $router->handle_log_request(
+                  exporter       => $class,
+                  caller_package => scalar(caller),
+                  caller_level   => 1,
+                  message_level  => $level,
+                  message_sub    => $code,
+                  message_args   => \@args,
+               );
+               return $args[0];
+            });
       }
       if ($spec->config->{dlog}) {
-         $spec->add_export("&Dlog_$level", sub (&@) {
-            my ($code, @args) = @_;
-            my $wrapped = sub {
-               local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
-               &$code;
-            };
-            $router->handle_log_request(
-               exporter => $class, caller_package => scalar(caller), caller_level => 1,
-               message_level => $level, message_sub => $wrapped, message_args => \@args,
-            );
-            return @args;
-         });
-         $spec->add_export("&DlogS_$level", sub (&$) {
-            my ($code, $ref) = @_;
-            my $wrapped = sub {
-               local $_ = Data::Dumper::Concise::Dumper($_[0]);
-               &$code;
-            };
-            $router->handle_log_request(
-               exporter => $class, caller_package => scalar(caller), caller_level => 1,
-               message_level => $level, message_sub => $wrapped, message_args => [ $ref ],
-            );
-            return $ref;
-         });
+         $spec->add_export(
+            "&Dlog_$level",
+            sub (&@) {
+               my ($code, @args) = @_;
+               my $wrapped = sub {
+                  local $_ = (@_ ? Data::Dumper::Concise::Dumper @_ : '()');
+                  &$code;
+               };
+               $router->handle_log_request(
+                  exporter       => $class,
+                  caller_package => scalar(caller),
+                  caller_level   => 1,
+                  message_level  => $level,
+                  message_sub    => $wrapped,
+                  message_args   => \@args,
+               );
+               return @args;
+            });
+         $spec->add_export(
+            "&DlogS_$level",
+            sub (&$) {
+               my ($code, $ref) = @_;
+               my $wrapped = sub {
+                  local $_ = Data::Dumper::Concise::Dumper($_[0]);
+                  &$code;
+               };
+               $router->handle_log_request(
+                  exporter       => $class,
+                  caller_package => scalar(caller),
+                  caller_level   => 1,
+                  message_level  => $level,
+                  message_sub    => $wrapped,
+                  message_args   => [$ref],
+               );
+               return $ref;
+            });
       }
    }
 }
 
 sub after_import {
    my ($class, $importer, $spec) = @_;
-   my %router_args = (exporter => $class, target => $importer, arguments => $spec->argument_info);
+   my %router_args = (
+      exporter  => $class,
+      target    => $importer,
+      arguments => $spec->argument_info
+   );
    $class->router->after_import(%router_args);
 }
 
@@ -151,9 +195,11 @@ Log::Contextual - Simple logging interface with a contextual log
      levels => [qw( trace debug )]
    });
 
+   my @args = @_;
+
    with_logger $minilogger => sub {
      log_trace { 'foo entered' };
-     my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
+     my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @args;
      # ...
      log_trace { 'foo left' };
    };
@@ -327,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] }
@@ -345,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