From: Arthur Axel 'fREW' Schmidt 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=refs%2Fheads%2Fbase-import;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__