use strict;
use warnings;
-our $VERSION = '0.004100';
+our $VERSION = '0.005001';
+$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 => ('____');
import_arguments qw(logger package_logger default_logger);
-sub before_import {
- my ($class, $importer, $spec) = @_;
+sub router {
+ our $Router_Instance ||= do {
+ require Log::Contextual::Router;
+ Log::Contextual::Router->new
+ }
+}
- die 'Log::Contextual does not have a default import list'
- if $spec->config->{default};
+sub default_import {
+ my ($class) = shift;
- my @levels = @{$class->arg_levels($spec->config->{levels})};
- for my $level (@levels) {
- if ($spec->config->{log}) {
- $spec->add_export("&log_$level", sub (&@) {
- _do_log( $level => _get_logger( caller ), shift @_, @_)
- });
- $spec->add_export("&logS_$level", sub (&@) {
- _do_logS( $level => _get_logger( caller ), $_[0], $_[1])
- });
- }
- if ($spec->config->{dlog}) {
- $spec->add_export("&Dlog_$level", sub (&@) {
- my ($code, @args) = @_;
- return _do_log( $level => _get_logger( caller ), sub {
- local $_ = (@args?Data::Dumper::Concise::Dumper @args:'()');
- $code->(@_)
- }, @args );
- });
- $spec->add_export("&DlogS_$level", sub (&$) {
- my ($code, $ref) = @_;
- _do_logS( $level => _get_logger( caller ), sub {
- local $_ = Data::Dumper::Concise::Dumper $ref;
- $code->($ref)
- }, $ref )
- });
- }
- }
+ 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_logger { $_[1] }
+sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
sub arg_package_logger { $_[1] }
sub arg_default_logger { $_[1] }
-sub after_import {
- my ($class, $importer, $specs) = @_;
-
- if (my $l = $class->arg_logger($specs->config->{logger})) {
- set_logger($l)
- }
-
- if (my $l = $class->arg_package_logger($specs->config->{package_logger})) {
- _set_package_logger_for($importer, $l)
- }
-
- if (my $l = $class->arg_default_logger($specs->config->{default_logger})) {
- _set_default_logger_for($importer, $l)
+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
+ );
+
+ 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;
}
-}
-our $Get_Logger;
-our %Default_Logger;
-our %Package_Logger;
+ $router->before_import(%router_args);
-sub _set_default_logger_for {
- my $logger = $_[1];
- if(ref $logger ne 'CODE') {
- die 'logger was not a CodeRef or a logger object. Please try again.'
- unless blessed($logger);
- $logger = do { my $l = $logger; sub { $l } }
- }
- $Default_Logger{$_[0]} = $logger
-}
+ if ($exports->{'&set_logger'}) {
+ die ref($router) . " does not support set_logger()"
+ unless $router->does('Log::Contextual::Role::Router::SetLogger');
-sub _set_package_logger_for {
- my $logger = $_[1];
- if(ref $logger ne 'CODE') {
- die 'logger was not a CodeRef or a logger object. Please try again.'
- unless blessed($logger);
- $logger = do { my $l = $logger; sub { $l } }
+ $spec->add_export('&set_logger', sub { $router->set_logger(@_) })
}
- $Package_Logger{$_[0]} = $logger
-}
-sub _get_logger($) {
- my $package = shift;
- (
- $Package_Logger{$package} ||
- $Get_Logger ||
- $Default_Logger{$package} ||
- die q( no logger set! you can't try to log something without a logger! )
- )->($package, { caller_level => 3 });
-}
+ if ($exports->{'&with_logger'}) {
+ die ref($router) . " does not support with_logger()"
+ unless $router->does('Log::Contextual::Role::Router::WithLogger');
-sub set_logger {
- my $logger = $_[0];
- if(ref $logger ne 'CODE') {
- die 'logger was not a CodeRef or a logger object. Please try again.'
- unless blessed($logger);
- $logger = do { my $l = $logger; sub { $l } }
+ $spec->add_export('&with_logger', sub { $router->with_logger(@_) })
}
- warn 'set_logger (or -logger) called more than once! This is a bad idea!'
- if $Get_Logger;
- $Get_Logger = $logger;
-}
-
-sub with_logger {
- my $logger = $_[0];
- if(ref $logger ne 'CODE') {
- die 'logger was not a CodeRef or a logger object. Please try again.'
- unless blessed($logger);
- $logger = do { my $l = $logger; sub { $l } }
+ 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];
+ });
+ }
+ 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;
+ });
+ }
}
- local $Get_Logger = $logger;
- $_[1]->();
-}
-
-sub _do_log {
- my $level = shift;
- my $logger = shift;
- my $code = shift;
- my @values = @_;
-
- $logger->$level($code->(@_))
- if $logger->${\"is_$level"};
- @values
}
-sub _do_logS {
- my $level = shift;
- my $logger = shift;
- my $code = shift;
- my $value = shift;
-
- $logger->$level($code->($value))
- if $logger->${\"is_$level"};
- $value
+sub after_import {
+ my ($class, $importer, $spec) = @_;
+ my %router_args = (
+ exporter => $class,
+ target => $importer,
+ arguments => $spec->argument_info
+ );
+ $class->router->after_import(%router_args);
}
1;
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' };
};
=item * Powerful
-C<Log::Contextual> chooses which logger to use based on L<< user defined C<CodeRef>s|/LOGGER CODEREF>>.
+C<Log::Contextual> chooses which logger to use based on L<< user defined C<CodeRef>s|/LOGGER CODEREF >>.
Normally you don't need to know this, but you can take advantage of it when you
need to later
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
coderef needs to use if it wants more caller information. The latter is in
a hashref to allow for more options in the future.
+Here is a basic example of a logger that exploits C<caller> to reproduce the
+output of C<warn> with a logger:
+
+ my @caller_info;
+ my $var_log = Log::Contextual::SimpleLogger->new({
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { chomp($_[0]); warn "$_[0] at $caller_info[1] line $caller_info[2].\n" }
+ });
+ my $warn_faker = sub {
+ my ($package, $args) = @_;
+ @caller_info = caller($args->{caller_level});
+ $var_log
+ };
+ set_logger($warn_faker);
+ log_debug { 'test' };
+
The following is an example that uses the information passed to the logger
coderef. It sets the global logger to C<$l3>, the logger for the C<A1>
package to C<$l1>, except the C<lol> method in C<A1> which uses the C<$l2>
logger and lastly the logger for the C<A2> package to C<$l2>.
+Note that it increases the caller level as it dispatches based on where
+the caller of the log function, not the log function itself.
+
my $complex_dispatcher = do {
my $l1 = ...;
my $logger = $registry{'-logger'};
if (my $r = $registry{$package}) {
$logger = $r->{'-logger'} if $r->{'-logger'};
- my (undef, undef, undef, $sub) = caller($info->{caller_level});
+ my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1);
$sub =~ s/^\Q$package\E:://g;
$logger = $r->{$sub} if $r->{$sub};
}
six take the results of whatever the user returned from their coderef and log
them. For a basic example see L<Log::Contextual::SimpleLogger>.
+=head1 LOG ROUTING
+
+In between the loggers and the log functions is a log router that is responsible for
+finding a logger to handle the log event and passing the log information to the
+logger. This relationship is described in the documentation for C<Log::Contextual::Role::Router>.
+
+C<Log::Contextual> and packages that extend it will by default share a router singleton that
+implements the with_logger() and set_logger() functions and also respects the -logger,
+-package_logger, and -default_logger import options with their associated default value
+functions. The router singleton is available as the return value of the router() function. Users
+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
+
+triddle - Tyler Riddle <t.riddle@shadowcat.co.uk>
+
=head1 DESIGNER
mst - Matt S. Trout <mst@shadowcat.co.uk>
projects / p5sagit/Log-Contextual.git / blobdiff