Fix RT#83267

The following code from Module::Metadata 1.000011 exposed the bug

   BEGIN {
     if ($INC{'Log/Contextual.pm'}) {
       Log::Contextual->import('log_info');
     } else {
       *log_info = sub (&) { warn $_[0]->() };
     }
   }

diff --git a/Changes b/Changes
index 40c1d3c..9d40243 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 ChangeLog for Log-Contextual
 
+  - Fix RT#83267 (Tyler Riddle)
+
 0.005001 2013-02-07
   - No changes from previous dev release
 

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index 4df4f46..65b154a 100644 (file)
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -13,6 +13,10 @@ use Exporter::Declare::Export::Generator;
 use Data::Dumper::Concise;
 use Scalar::Util 'blessed';
 
+my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
+
+my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
+
 eval {
    require Log::Log4perl;
    die if $Log::Log4perl::VERSION < 1.29;
@@ -23,7 +27,10 @@ eval {
 # export anything but the levels selected
 sub ____ { }
 
-exports(qw(____ set_logger with_logger ));
+exports ('____',
+   @dlog, @log,
+   qw( set_logger with_logger )
+);
 
 export_tag dlog => ('____');
 export_tag log  => ('____');
@@ -87,7 +94,7 @@ sub before_import {
 
    my @levels = @{$class->arg_levels($spec->config->{levels})};
    for my $level (@levels) {
-      if ($spec->config->{log}) {
+      if ($spec->config->{log} || $exports->{"&log_$level"}) {
          $spec->add_export(
             "&log_$level",
             sub (&@) {
@@ -102,6 +109,8 @@ sub before_import {
                );
                return @args;
             });
+      }
+      if ($spec->config->{log} || $exports->{"&logS_$level"}) {
          $spec->add_export(
             "&logS_$level",
             sub (&@) {
@@ -117,7 +126,7 @@ sub before_import {
                return $args[0];
             });
       }
-      if ($spec->config->{dlog}) {
+      if ($spec->config->{dlog} || $exports->{"&Dlog_$level"}) {
          $spec->add_export(
             "&Dlog_$level",
             sub (&@) {
@@ -136,6 +145,8 @@ sub before_import {
                );
                return @args;
             });
+      }
+      if ($spec->config->{dlog} || $exports->{"&DlogS_$level"}) {
          $spec->add_export(
             "&DlogS_$level",
             sub (&$) {

diff --git a/t/rt83267-begin.t b/t/rt83267-begin.t
new file mode 100644 (file)
index 0000000..882095f
--- /dev/null
+++ b/t/rt83267-begin.t
@@ -0,0 +1,23 @@
+use Test::More qw(no_plan);
+
+BEGIN {
+   eval {
+      package NotMain;
+
+      use strict;
+      use warnings;
+      use Test::More;
+      use Log::Contextual::SimpleLogger;
+
+      use Log::Contextual qw(:log),
+        -default_logger =>
+        Log::Contextual::SimpleLogger->new({levels => [qw( )]});
+
+      eval {
+         log_info { "Yep" }
+      };
+      is($@, '', 'Invoked log function in package other than main');
+   };
+
+   is($@, '', 'non-main package subtest did not die');
+}

diff --git a/t/rt83267.t b/t/rt83267.t
new file mode 100644 (file)
index 0000000..0eb1a04
--- /dev/null
+++ b/t/rt83267.t
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+use Test::More 'no_plan';
+
+#bug report does not include a case where Log::Contextual is
+#brought in via 'use'
+
+#try to import a single log function but do not include any tags
+BEGIN {
+   require Log::Contextual;
+   Log::Contextual->import('log_info');
+}
+
+eval {
+   log_info { "test" };
+};
+like(
+   $@,
+   qr/^ no logger set!  you can't try to log something without a logger!/,
+   'Got correct error'
+);