use strict;
use warnings;
-our $VERSION = '0.004202';
+our $VERSION = '0.005000_02';
+$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
my @levels = qw(debug trace warn info error fatal);
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;
# ____ is because tags must have at least one export and we don't want to
# export anything but the levels selected
-sub ____ {}
+sub ____ { }
-exports ('____',
- @dlog, @log,
- qw( set_logger with_logger )
-);
+exports(qw(____ set_logger with_logger ));
export_tag dlog => ('____');
export_tag log => ('____');
our $Router_Instance ||= do {
require Log::Contextual::Router;
Log::Contextual::Router->new
- }
+ }
}
-sub arg_logger { $_[1] }
-sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
+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_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');
-
- return $router->set_logger(@_);
- }) if $exports->{'&set_logger'};
+ unless $router->does('Log::Contextual::Role::Router::SetLogger');
- $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);
}
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' };
};
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] }
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