Stop depending on XS module Sub::Identify
[p5sagit/Log-Contextual.git] / lib / Log / Contextual.pm
index 2fe59eb..54f33f4 100644 (file)
@@ -1,11 +1,10 @@
 package Log::Contextual;
 
+# ABSTRACT: Simple logging interface with a contextual log
+
 use strict;
 use warnings;
 
-our $VERSION = '0.005002';
-$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
-
 my @levels = qw(debug trace warn info error fatal);
 
 use Exporter::Declare;
@@ -13,10 +12,36 @@ use Exporter::Declare::Export::Generator;
 use Data::Dumper::Concise;
 use Scalar::Util 'blessed';
 
+use B qw(svref_2object);
+
+sub stash_name {
+   my ($coderef) = @_;
+   ref $coderef or return;
+   my $cv = B::svref_2object($coderef);
+   $cv->isa('B::CV') or return;
+   # bail out if GV is undefined
+   $cv->GV->isa('B::SPECIAL') and return;
+
+   return $cv->GV->STASH->NAME;
+}
+
 my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
 
 my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
 
+sub _maybe_export {
+   my ($spec, $target, $name, $new_code) = @_;
+
+   if (my $code = $target->can($name)) {
+
+      # this will warn
+      $spec->add_export("&$name", $new_code)
+        unless (stash_name($code) eq __PACKAGE__);
+   } else {
+      $spec->add_export("&$name", $new_code)
+   }
+}
+
 eval {
    require Log::Log4perl;
    die if $Log::Log4perl::VERSION < 1.29;
@@ -27,10 +52,7 @@ eval {
 # export anything but the levels selected
 sub ____ { }
 
-exports ('____',
-   @dlog, @log,
-   qw( set_logger with_logger )
-);
+exports('____', @dlog, @log, qw( set_logger with_logger ));
 
 export_tag dlog => ('____');
 export_tag log  => ('____');
@@ -82,21 +104,27 @@ sub before_import {
       die ref($router) . " does not support set_logger()"
         unless $router->does('Log::Contextual::Role::Router::SetLogger');
 
-      $spec->add_export('&set_logger', sub { $router->set_logger(@_) })
+      _maybe_export($spec, $importer, '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');
 
-      $spec->add_export('&with_logger', sub { $router->with_logger(@_) })
+      _maybe_export($spec, $importer, 'with_logger',
+         sub { $router->with_logger(@_) },
+      );
    }
 
    my @levels = @{$class->arg_levels($spec->config->{levels})};
    for my $level (@levels) {
       if ($spec->config->{log} || $exports->{"&log_$level"}) {
-         $spec->add_export(
-            "&log_$level",
+         _maybe_export(
+            $spec,
+            $importer,
+            "log_$level",
             sub (&@) {
                my ($code, @args) = @_;
                $router->handle_log_request(
@@ -108,11 +136,14 @@ sub before_import {
                   message_args   => \@args,
                );
                return @args;
-            });
+            },
+         );
       }
       if ($spec->config->{log} || $exports->{"&logS_$level"}) {
-         $spec->add_export(
-            "&logS_$level",
+         _maybe_export(
+            $spec,
+            $importer,
+            "logS_$level",
             sub (&@) {
                my ($code, @args) = @_;
                $router->handle_log_request(
@@ -124,11 +155,14 @@ sub before_import {
                   message_args   => \@args,
                );
                return $args[0];
-            });
+            },
+         );
       }
       if ($spec->config->{dlog} || $exports->{"&Dlog_$level"}) {
-         $spec->add_export(
-            "&Dlog_$level",
+         _maybe_export(
+            $spec,
+            $importer,
+            "Dlog_$level",
             sub (&@) {
                my ($code, @args) = @_;
                my $wrapped = sub {
@@ -144,11 +178,14 @@ sub before_import {
                   message_args   => \@args,
                );
                return @args;
-            });
+            },
+         );
       }
       if ($spec->config->{dlog} || $exports->{"&DlogS_$level"}) {
-         $spec->add_export(
-            "&DlogS_$level",
+         _maybe_export(
+            $spec,
+            $importer,
+            "DlogS_$level",
             sub (&$) {
                my ($code, $ref) = @_;
                my $wrapped = sub {
@@ -179,14 +216,20 @@ sub after_import {
    $class->router->after_import(%router_args);
 }
 
+for (qw(set with)) {
+   no strict 'refs';
+   my $sub = "${_}_logger";
+   *{"Log::Contextual::$sub"} = sub {
+      die "$sub is no longer a direct sub in Log::Contextual.  "
+        . 'Note that this feature was never tested nor documented.  '
+        . "Please fix your code to import $sub instead of trying to use it directly"
+     }
+}
+
 1;
 
 __END__
 
-=head1 NAME
-
-Log::Contextual - Simple logging interface with a contextual log
-
 =head1 SYNOPSIS
 
  use Log::Contextual qw( :log :dlog set_logger with_logger );
@@ -305,7 +348,7 @@ wide.
 =head2 -logger
 
 When you import this module you may use C<-logger> as a shortcut for
-L<set_logger>, for example:
+L</set_logger>, for example:
 
  use Log::Contextual::SimpleLogger;
  use Log::Contextual qw( :dlog ),
@@ -332,7 +375,7 @@ supporting those levels is as easy as doing
 =head2 -package_logger
 
 The C<-package_logger> import option is similar to the C<-logger> import option
-except C<-package_logger> sets the the logger for the current package.
+except C<-package_logger> sets the logger for the current package.
 
 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
 L</set_logger>.
@@ -350,7 +393,7 @@ CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
 =head2 -default_logger
 
 The C<-default_logger> import option is similar to the C<-logger> import option
-except C<-default_logger> sets the the B<default> logger for the current package.
+except C<-default_logger> sets the B<default> logger for the current package.
 
 Basically it sets the logger to be used if C<set_logger> is never called; so
 
@@ -414,6 +457,9 @@ import.  So the following will all work:
 
  sub default_import { qw(:dlog :log ) }
 
+See L<Log::Contextual::Easy::Default> for an example of a subclass of
+C<Log::Contextual> that makes use of default import options.
+
 =head1 FUNCTIONS
 
 =head2 set_logger
@@ -661,27 +707,17 @@ functions. The router singleton is available as the return value of the router()
 of Log::Contextual may overload router() to return instances of custom log routers that
 could for example work with loggers that use a different interface.
 
-=head1 AUTHOR
-
-frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
-
 =head1 CONTRIBUTORS
 
+=encoding utf8
+
 triddle - Tyler Riddle <t.riddle@shadowcat.co.uk>
 
+voj - Jakob Voß <voss@gbv.de>
+
 =head1 DESIGNER
 
 mst - Matt S. Trout <mst@shadowcat.co.uk>
 
-=head1 COPYRIGHT
-
-Copyright (c) 2012 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
-above.
-
-=head1 LICENSE
-
-This library is free software and may be distributed under the same terms as
-Perl 5 itself.
-
 =cut