package Log::Contextual;
+# ABSTRACT: Simple logging interface with a contextual log
+
use strict;
use warnings;
-our $VERSION = '0.004202';
-
my @levels = qw(debug trace warn info error fatal);
use Exporter::Declare;
use Exporter::Declare::Export::Generator;
use Data::Dumper::Concise;
use Scalar::Util 'blessed';
-use Log::Contextual::Router;
+
+use B qw(svref_2object);
+
+sub stash_name {
+ my ($coderef) = @_;
+ ref $coderef or return;
+ my $cv = B::svref_2object($coderef);
+ $cv->isa('B::CV') or return;
+ # bail out if GV is undefined
+ $cv->GV->isa('B::SPECIAL') and return;
+
+ return $cv->GV->STASH->NAME;
+}
my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
+sub _maybe_export {
+ my ($spec, $target, $name, $new_code) = @_;
+
+ if (my $code = $target->can($name)) {
+
+ # this will warn
+ $spec->add_export("&$name", $new_code)
+ unless (stash_name($code) eq __PACKAGE__);
+ } else {
+ $spec->add_export("&$name", $new_code)
+ }
+}
+
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('____', @dlog, @log, qw( set_logger with_logger ));
export_tag dlog => ('____');
export_tag log => ('____');
import_arguments qw(logger package_logger default_logger);
-sub arg_router { return $_[1] if defined $_[1]; our $Router_Instance ||= Log::Contextual::Router->new }
-sub arg_logger { $_[1] }
-sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
+sub router {
+ our $Router_Instance ||= do {
+ require Log::Contextual::Router;
+ Log::Contextual::Router->new
+ }
+}
+
+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->arg_router;
+ 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);
+
+ if ($exports->{'&set_logger'}) {
+ die ref($router) . " does not support set_logger()"
+ unless $router->does('Log::Contextual::Role::Router::SetLogger');
+
+ _maybe_export($spec, $importer, 'set_logger',
+ sub { $router->set_logger(@_) },
+ );
+ }
- die 'Log::Contextual does not have a default import list'
- if $spec->config->{default};
+ if ($exports->{'&with_logger'}) {
+ die ref($router) . " does not support with_logger()"
+ unless $router->does('Log::Contextual::Role::Router::WithLogger');
- $router->before_import(@_);
+ _maybe_export($spec, $importer, '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({
- package => scalar(caller),
- caller_level => 1,
- level => $level,
- }, $code, @args);
- return @args;
- });
- $spec->add_export("&logS_$level", sub (&@) {
- my ($code, @args) = @_;
- $router->handle_log_request({
- package => scalar(caller),
- caller_level => 1,
- level => $level,
- }, $code, @args);
- return $args[0];
- });
+ if ($spec->config->{log} || $exports->{"&log_$level"}) {
+ _maybe_export(
+ $spec,
+ $importer,
+ "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;
+ },
+ );
+ }
+ if ($spec->config->{log} || $exports->{"&logS_$level"}) {
+ _maybe_export(
+ $spec,
+ $importer,
+ "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} || $exports->{"&Dlog_$level"}) {
+ _maybe_export(
+ $spec,
+ $importer,
+ "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;
+ },
+ );
}
- 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({
- package => scalar(caller),
- caller_level => 1,
- level => $level,
- }, $wrapped, @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({
- package => scalar(caller),
- caller_level => 1,
- level => $level,
- }, $wrapped, $ref);
- return $ref;
- });
+ if ($spec->config->{dlog} || $exports->{"&DlogS_$level"}) {
+ _maybe_export(
+ $spec,
+ $importer,
+ "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 { return arg_router()->after_import(@_) }
-
-sub set_logger {
- my $router = arg_router();
-
- die ref($router) . " does not support set_logger()"
- unless $router->does('Log::Contextual::Role::Router::SetLogger');
-
- return $router->set_logger(@_);
+sub after_import {
+ my ($class, $importer, $spec) = @_;
+ my %router_args = (
+ exporter => $class,
+ target => $importer,
+ arguments => $spec->argument_info
+ );
+ $class->router->after_import(%router_args);
}
-sub with_logger {
- my $router = arg_router();
-
- die ref($router) . " does not support with_logger()"
- unless $router->does('Log::Contextual::Role::Router::WithLogger');
-
- return $router->with_logger(@_);
+for (qw(set with)) {
+ no strict 'refs';
+ my $sub = "${_}_logger";
+ *{"Log::Contextual::$sub"} = sub {
+ die "$sub is no longer a direct sub in Log::Contextual. "
+ . 'Note that this feature was never tested nor documented. '
+ . "Please fix your code to import $sub instead of trying to use it directly"
+ }
}
1;
__END__
-=head1 NAME
-
-Log::Contextual - Simple logging interface with a contextual log
-
=head1 SYNOPSIS
use Log::Contextual qw( :log :dlog set_logger with_logger );
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' };
};
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
+need to later.
=item * Scalable
-If you just want to add logging to your extremely basic application, start with
+If you just want to add logging to your basic application, start with
L<Log::Contextual::SimpleLogger> and then as your needs grow you can switch to
L<Log::Dispatchouli> or L<Log::Dispatch> or L<Log::Log4perl> or whatever else.
while still allowing you to switch from one logger to another.
It is bundled with a really basic logger, L<Log::Contextual::SimpleLogger>,
-but in general you should use a real logger instead of that. For something
+but in general you should use a real logger instead. For something
more serious but not overly complicated, try L<Log::Dispatchouli> (see
L</SYNOPSIS> for example.)
=head2 -logger
When you import this module you may use C<-logger> as a shortcut for
-L<set_logger>, for example:
+L</set_logger>, for example:
use Log::Contextual::SimpleLogger;
use Log::Contextual qw( :dlog ),
=head2 -package_logger
The C<-package_logger> import option is similar to the C<-logger> import option
-except C<-package_logger> sets the the logger for the current package.
+except C<-package_logger> sets the logger for the current package.
Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
-L</set_logger>.
+L</set_logger> or L</with_logger>.
package My::Package;
use Log::Contextual::SimpleLogger;
=head2 -default_logger
The C<-default_logger> import option is similar to the C<-logger> import option
-except C<-default_logger> sets the the B<default> logger for the current package.
+except C<-default_logger> sets the B<default> logger for the current package.
Basically it sets the logger to be used if C<set_logger> is never called; so
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] }
Note the C<< $_[1] || >> in C<arg_default_logger>. All of these methods are
passed the values passed in from the arguments to the subclass, so you can
-either throw them away, honor them, die on usage, or whatever. To be clear,
+either throw them away, honor them, die on usage, etc. To be clear,
if you define your subclass, and someone uses it as follows:
use MyApp::Log::Contextual -default_logger => $foo,
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 ) }
+
+See L<Log::Contextual::Easy::Default> for an example of a subclass of
+C<Log::Contextual> that makes use of default import options.
+
=head1 FUNCTIONS
=head2 set_logger
Anywhere a logger object can be passed, a coderef is accepted. This is so
that the user can use different logger objects based on runtime information.
-The logger coderef is passed the package of the caller the caller level the
+The logger coderef is passed the package of the caller, and the caller level the
coderef needs to use if it wants more caller information. The latter is in
a hashref to allow for more options in the future.
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 AUTHOR
+=head1 LOG ROUTING
-frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
+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>.
-=head1 DESIGNER
+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.
-mst - Matt S. Trout <mst@shadowcat.co.uk>
+=head1 CONTRIBUTORS
-=head1 COPYRIGHT
+=encoding utf8
-Copyright (c) 2012 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
-above.
+triddle - Tyler Riddle <t.riddle@shadowcat.co.uk>
-=head1 LICENSE
+voj - Jakob Voß <voss@gbv.de>
-This library is free software and may be distributed under the same terms as
-Perl 5 itself.
+=head1 DESIGNER
+
+mst - Matt S. Trout <mst@shadowcat.co.uk>
=cut
projects / p5sagit/Log-Contextual.git / blobdiff