From: Arthur Axel 'fREW' Schmidt <frioux@gmail.com>
Date: Thu, 28 Jul 2011 03:35:28 +0000 (-0500)
Subject: Switch from Exporter to Sub::Exporter for awesome import features
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8b278a9205c5edcd3353edb8674c08e6ba23d37d;p=p5sagit%2FLog-Contextual.git

Switch from Exporter to Sub::Exporter for awesome import features
---

diff --git a/Changes b/Changes
index 7fbc261..41694c6 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 ChangeLog for Log-Contextual
 
+  - Switch from Exporter to Sub::Exporter for awesome import features
+
 0.00305 2011-07-27
   - Fix regression that caused D* subs to dumper even if the log level was off
 
diff --git a/Makefile.PL b/Makefile.PL
index 4b0cf68..427c969 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -6,5 +6,6 @@ use warnings FATAL => 'all';
 perl_version '5.006';
 all_from 'lib/Log/Contextual.pm';
 requires 'Data::Dumper::Concise';
+requires 'Sub::Exporter' => 0.982;
 
 WriteAll;
diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index 23c7aff..1c4ad71 100644
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -6,53 +6,117 @@ use warnings;
 our $VERSION = '0.00305';
 
 my @levels = qw(debug trace warn info error fatal);
+use Sub::Exporter 'build_exporter';
 
-require Exporter;
 use Data::Dumper::Concise;
 use Scalar::Util 'blessed';
 
-BEGIN { our @ISA = qw(Exporter) }
-
-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;
    Log::Log4perl->wrapper_register(__PACKAGE__)
 };
 
-our @EXPORT_OK = (
-   @dlog, @log,
-   qw( set_logger with_logger )
-);
+sub parse_arguments {
+  my $self = shift;
+  my $caller = shift;
+  my @args = @{shift @_};
+
+  die 'Log::Contextual does not have a default import list'
+     unless @args;
+
+  my $skipnext;
+  my @rest;
+  for my $idx ( 0 .. $#args ) {
+    my $val = $args[$idx];
 
-our %EXPORT_TAGS = (
-   dlog => \@dlog,
-   log  => \@log,
-   all  => [@dlog, @log],
-);
+    next unless defined $val;
+    if ($skipnext) {
+      $skipnext--;
+      next;
+    }
+
+    if ( $val eq '-logger' ) {
+      set_logger($args[$idx + 1]);
+      $skipnext = 1;
+    } elsif ( $val eq '-package_logger' ) {
+      _set_package_logger_for($caller, $args[$idx + 1]);
+      $skipnext = 1;
+    } elsif ( $val eq '-default_logger' ) {
+      _set_default_logger_for($caller, $args[$idx + 1]);
+      $skipnext = 1;
+    } else {
+      push @rest, $val;
+    }
+  }
 
+  return \@rest
+}
+
+{
 sub import {
-   my $package = shift;
-   die 'Log::Contextual does not have a default import list'
-      unless @_;
-
-   for my $idx ( 0 .. $#_ ) {
-      my $val = $_[$idx];
-      if ( defined $val && $val eq '-logger' ) {
-         set_logger($_[$idx + 1]);
-         splice @_, $idx, 2;
-      } elsif ( defined $val && $val eq '-package_logger' ) {
-         _set_package_logger_for(scalar caller, $_[$idx + 1]);
-         splice @_, $idx, 2;
-      } elsif ( defined $val && $val eq '-default_logger' ) {
-         _set_default_logger_for(scalar caller, $_[$idx + 1]);
-         splice @_, $idx, 2;
-      }
-   }
-   $package->export_to_level(1, $package, @_);
+   my $self = shift;
+
+   my $inheritor = caller(0);
+   my @rest      = @{$self->parse_arguments($inheritor, \@_)};
+
+   @_ = ($self, @rest);
+
+   my @dlog = ( (map "Dlog_$_", @levels), (map "DlogS_$_", @levels) );
+   my @log  = ( (map "log_$_",  @levels), (map "logS_$_",  @levels) );
+
+   my $import = build_exporter({
+      exports => [
+         (map {
+            my $level = $_;
+            "Dlog_$_" => sub {
+               sub (&@) {
+                 my ($code, @args) = @_;
+                 return _do_log( $level => _get_logger( $inheritor ), sub {
+                    local $_ = (@args?Data::Dumper::Concise::Dumper @args:'()');
+                    $code->(@_)
+                 }, @args );
+               }
+            }
+         } @levels),
+         (map {
+            my $level = $_;
+            "DlogS_$_" => sub {
+               sub (&$) {
+                 my ($code, $ref) = @_;
+                 _do_logS( $level => _get_logger( $inheritor ), sub {
+                    local $_ = Data::Dumper::Concise::Dumper $ref;
+                    $code->($ref)
+                 }, $ref )
+               }
+            }
+         } @levels),
+         (map {
+            my $level = $_;
+            "log_$_" => sub {
+               sub (&@) {
+                  _do_log( $level => _get_logger( $inheritor ), shift @_, @_)
+               }
+            }
+         }  @levels),
+         (map {
+            my $level = $_;
+            "logS_$_" => sub {
+               sub (&$) {
+                  _do_logS( $level => _get_logger( caller ), $_[0], $_[1])
+               }
+            }
+         }  @levels),
+         qw( set_logger with_logger )
+      ],
+      groups  => {
+        dlog => \@dlog,
+        log  => \@log,
+        all  => [ @dlog, @log, qw( set_logger with_logger ) ],
+      },
+   });
+   goto $import
+}
 }
 
 our $Get_Logger;
@@ -135,34 +199,6 @@ sub _do_logS {
    $value
 }
 
-for my $level (@levels) {
-   no strict 'refs';
-
-   *{"log_$level"} = sub (&@) {
-      _do_log( $level => _get_logger( caller ), shift @_, @_)
-   };
-
-   *{"logS_$level"} = sub (&$) {
-      _do_logS( $level => _get_logger( caller ), $_[0], $_[1])
-   };
-
-   *{"Dlog_$level"} = sub (&@) {
-     my ($code, @args) = @_;
-     return _do_log( $level => _get_logger( caller ), sub {
-        local $_ = (@args?Data::Dumper::Concise::Dumper @args:'()');
-        $code->(@_)
-     }, @args );
-   };
-
-   *{"DlogS_$level"} = sub (&$) {
-     my ($code, $ref) = @_;
-     _do_logS( $level => _get_logger( caller ), sub {
-        local $_ = Data::Dumper::Concise::Dumper $ref;
-        $code->($ref)
-     }, $ref )
-   };
-}
-
 1;
 
 __END__