package Log::Contextual;
+# ABSTRACT: Simple logging interface with a contextual log
+
use strict;
use warnings;
-our $VERSION = '0.00304';
+my @levels = qw(debug trace warn info error fatal);
-require Exporter;
+use Exporter::Declare;
+use Exporter::Declare::Export::Generator;
use Data::Dumper::Concise;
use Scalar::Util 'blessed';
-BEGIN { our @ISA = qw(Exporter) }
-
-my @dlog = (qw(
- Dlog_debug DlogS_debug
- Dlog_trace DlogS_trace
- Dlog_warn DlogS_warn
- Dlog_info DlogS_info
- Dlog_error DlogS_error
- Dlog_fatal DlogS_fatal
- ));
-
-my @log = (qw(
- log_debug logS_debug
- log_trace logS_trace
- log_warn logS_warn
- log_info logS_info
- log_error logS_error
- log_fatal logS_fatal
- ));
-
-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 )
-);
-
-our %EXPORT_TAGS = (
- dlog => \@dlog,
- log => \@log,
- all => [@dlog, @log],
-);
-
-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, @_);
-}
+use B qw(svref_2object);
-our $Get_Logger;
-our %Default_Logger;
-our %Package_Logger;
+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;
-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
+ return $cv->GV->STASH->NAME;
}
-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 } }
- }
- $Package_Logger{$_[0]} = $logger
-}
+my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
-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);
-}
+my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
-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 } }
- }
+sub _maybe_export {
+ my ($spec, $target, $name, $new_code) = @_;
- warn 'set_logger (or -logger) called more than once! This is a bad idea!'
- if $Get_Logger;
- $Get_Logger = $logger;
-}
+ if (my $code = $target->can($name)) {
-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 } }
+ # this will warn
+ $spec->add_export("&$name", $new_code)
+ unless (stash_name($code) eq __PACKAGE__);
+ } else {
+ $spec->add_export("&$name", $new_code)
}
- local $Get_Logger = $logger;
- $_[1]->();
}
-sub _do_log {
- my $level = shift;
- my $logger = shift;
- my $code = shift;
- my @values = @_;
+eval {
+ require Log::Log4perl;
+ die if $Log::Log4perl::VERSION < 1.29;
+ Log::Log4perl->wrapper_register(__PACKAGE__)
+};
- $logger->$level($code->(@_))
- if $logger->${\"is_$level"};
- @values
-}
+# ____ is because tags must have at least one export and we don't want to
+# export anything but the levels selected
+sub ____ { }
-sub _do_logS {
- my $level = shift;
- my $logger = shift;
- my $code = shift;
- my $value = shift;
+exports('____', @dlog, @log, qw( set_logger with_logger ));
- $logger->$level($code->($value))
- if $logger->${\"is_$level"};
- $value
-}
+export_tag dlog => ('____');
+export_tag log => ('____');
+import_arguments qw(logger package_logger default_logger);
-sub log_trace (&@) { _do_log( trace => _get_logger( caller ), shift @_, @_) }
-sub log_debug (&@) { _do_log( debug => _get_logger( caller ), shift @_, @_) }
-sub log_info (&@) { _do_log( info => _get_logger( caller ), shift @_, @_) }
-sub log_warn (&@) { _do_log( warn => _get_logger( caller ), shift @_, @_) }
-sub log_error (&@) { _do_log( error => _get_logger( caller ), shift @_, @_) }
-sub log_fatal (&@) { _do_log( fatal => _get_logger( caller ), shift @_, @_) }
-
-sub logS_trace (&$) { _do_logS( trace => _get_logger( caller ), $_[0], $_[1]) }
-sub logS_debug (&$) { _do_logS( debug => _get_logger( caller ), $_[0], $_[1]) }
-sub logS_info (&$) { _do_logS( info => _get_logger( caller ), $_[0], $_[1]) }
-sub logS_warn (&$) { _do_logS( warn => _get_logger( caller ), $_[0], $_[1]) }
-sub logS_error (&$) { _do_logS( error => _get_logger( caller ), $_[0], $_[1]) }
-sub logS_fatal (&$) { _do_logS( fatal => _get_logger( caller ), $_[0], $_[1]) }
-
-
-sub Dlog_trace (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( trace => _get_logger( caller ), $code, @_ );
+sub router {
+ our $Router_Instance ||= do {
+ require Log::Contextual::Router;
+ Log::Contextual::Router->new
+ }
}
-sub Dlog_debug (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( debug => _get_logger( caller ), $code, @_ );
-}
+sub default_import {
+ my ($class) = shift;
-sub Dlog_info (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( info => _get_logger( caller ), $code, @_ );
-}
+ die 'Log::Contextual does not have a default import list';
-sub Dlog_warn (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( warn => _get_logger( caller ), $code, @_ );
+ ()
}
-sub Dlog_error (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( error => _get_logger( caller ), $code, @_ );
-}
+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
+ );
+
+ 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;
+ }
-sub Dlog_fatal (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( fatal => _get_logger( caller ), $code, @_ );
-}
+ $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');
-sub DlogS_trace (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( trace => _get_logger( caller ), $_[0], $_[1] )
-}
+ _maybe_export($spec, $importer, 'set_logger',
+ sub { $router->set_logger(@_) },
+ );
+ }
-sub DlogS_debug (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( debug => _get_logger( caller ), $_[0], $_[1] )
-}
+ if ($exports->{'&with_logger'}) {
+ die ref($router) . " does not support with_logger()"
+ unless $router->does('Log::Contextual::Role::Router::WithLogger');
-sub DlogS_info (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( info => _get_logger( caller ), $_[0], $_[1] )
-}
+ _maybe_export($spec, $importer, 'with_logger',
+ sub { $router->with_logger(@_) },
+ );
+ }
-sub DlogS_warn (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( warn => _get_logger( caller ), $_[0], $_[1] )
+ my @levels = @{$class->arg_levels($spec->config->{levels})};
+ for my $level (@levels) {
+ 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} || $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 DlogS_error (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( error => _get_logger( caller ), $_[0], $_[1] )
+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 DlogS_fatal (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( fatal => _get_logger( caller ), $_[0], $_[1] )
+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 );
use Log::Log4perl ':easy';
Log::Log4perl->easy_init($DEBUG);
-
my $logger = Log::Log4perl->get_logger;
set_logger $logger;
log_debug { 'program started' };
sub foo {
- with_logger(Log::Contextual::SimpleLogger->new({
- levels => [qw( trace debug )]
- }) => sub {
+
+ my $minilogger = Log::Contextual::SimpleLogger->new({
+ 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' };
- });
+ };
}
foo();
=head1 DESCRIPTION
-This module is a simple interface to extensible logging. 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 more serious but not
-overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
+Major benefits:
+
+=over 2
+
+=item * Efficient
+
+The logging functions take blocks, so if a log level is disabled, the
+block will not run:
+
+ # the following won't run if debug is off
+ log_debug { "the new count in the database is " . $rs->count };
+
+Similarly, the C<D> prefixed methods only C<Dumper> the input if the level is
+enabled.
+
+=item * Handy
+
+The logging functions return their arguments, so you can stick them in
+the middle of expressions:
+
+ for (log_debug { "downloading:\n" . join qq(\n), @_ } @urls) { ... }
+
+=item * Generic
+
+C<Log::Contextual> is an interface for all major loggers. If you log through
+C<Log::Contextual> you will be able to swap underlying loggers later.
+
+=item * Powerful
+
+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.
+
+=item * Scalable
+
+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.
+
+=back
+
+This module is a simple interface to extensible logging. It exists to
+abstract your logging interface so that logging is as painless as possible,
+while still allowing you to switch from one logger to another.
-=head1 OPTIONS
+It is bundled with a really basic logger, L<Log::Contextual::SimpleLogger>,
+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.)
+
+=head1 A WORK IN PROGRESS
+
+This module is certainly not complete, but we will not break the interface
+lightly, so I would say it's safe to use in production code. The main result
+from that at this point is that doing:
+
+ use Log::Contextual;
+
+will die as we do not yet know what the defaults should be. If it turns out
+that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
+probably make C<:log> the default. But only time and usage will tell.
+
+=head1 IMPORT OPTIONS
+
+See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
+wide.
=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 ),
BEGIN { $var_log = VarLogger->new }
use Log::Contextual qw( :dlog ), -logger => $var_log;
+=head2 -levels
+
+The C<-levels> import option allows you to define exactly which levels your
+logger supports. So the default,
+C<< [qw(debug trace warn info error fatal)] >>, works great for
+L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>. But
+supporting those levels is as easy as doing
+
+ use Log::Contextual
+ -levels => [qw( debug info notice warning error critical alert emergency )];
+
=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
env_prefix => 'MY_PACKAGE'
});
-=head1 A WORK IN PROGRESS
+=head1 SETTING DEFAULT IMPORT OPTIONS
-This module is certainly not complete, but we will not break the interface
-lightly, so I would say it's safe to use in production code. The main result
-from that at this point is that doing:
+Eventually you will get tired of writing the following in every single one of
+your packages:
- use Log::Contextual;
+ use Log::Log4perl;
+ use Log::Log4perl ':easy';
+ BEGIN { Log::Log4perl->easy_init($DEBUG) }
-will die as we do not yet know what the defaults should be. If it turns out
-that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
-probably make C<:log> the default. But only time and usage will tell.
+ use Log::Contextual -logger => Log::Log4perl->get_logger;
+
+You can set any of the import options for your whole project if you define your
+own C<Log::Contextual> subclass as follows:
+
+ package MyApp::Log::Contextual;
+
+ use base 'Log::Contextual';
+
+ use Log::Log4perl ':easy';
+ Log::Log4perl->easy_init($DEBUG)
+
+ 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] }
+
+ # and almost definitely not this, which is only here for completeness
+ sub arg_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, etc. To be clear,
+if you define your subclass, and someone uses it as follows:
+
+ use MyApp::Log::Contextual -default_logger => $foo,
+ -levels => [qw(bar baz biff)];
+
+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
my $logger = WarnLogger->new;
set_logger $logger;
-Arguments: C<Ref|CodeRef $returning_logger>
+Arguments: L</LOGGER CODEREF>
C<set_logger> will just set the current logger to whatever you pass it. It
expects a C<CodeRef>, but if you pass it something else it will wrap it in a
}
};
-Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
+Arguments: L</LOGGER CODEREF>, C<CodeRef $to_execute>
C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
Arguments: C<CodeRef $returning_message, @args>
-All of the following six functions work the same except that a different method
+C<log_$level> functions all work the same except that a different method
is called on the underlying C<$logger> object. The basic pattern is:
sub log_$level (&@) {
If you want complete inspection of passthrough data, take a look at the
L</Dlog_$level> functions.
-=head3 log_trace
-
- log_trace { 'entered method foo with args ' join q{,}, @args };
+Which functions are exported depends on what was passed to L</-levels>. The
+default (no C<-levels> option passed) would export:
-=head3 log_debug
+=over 2
- log_debug { 'entered method foo' };
+=item log_trace
-=head3 log_info
+=item log_debug
- log_info { 'started process foo' };
+=item log_info
-=head3 log_warn
+=item log_warn
- log_warn { 'possible misconfiguration at line 10' };
+=item log_error
-=head3 log_error
+=item log_fatal
- log_error { 'non-numeric user input!' };
-
-=head3 log_fatal
-
- log_fatal { '1 is never equal to 0!' };
+=back
=head2 logS_$level
"fRUE"
"fiSMBoC"
-=head3 Dlog_trace
-
- my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
-
-=head3 Dlog_debug
+Which functions are exported depends on what was passed to L</-levels>. The
+default (no C<-levels> option passed) would export:
- Dlog_debug { "random data structure: $_" } { foo => $bar };
+=over 2
-=head3 Dlog_info
+=item Dlog_trace
- return Dlog_info { "html from method returned: $_" } "<html>...</html>";
+=item Dlog_debug
-=head3 Dlog_warn
+=item Dlog_info
- Dlog_warn { "probably invalid value: $_" } $foo;
+=item Dlog_warn
-=head3 Dlog_error
+=item Dlog_error
- Dlog_error { "non-numeric user input! ($_)" } $port;
+=item Dlog_fatal
-=head3 Dlog_fatal
-
- Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
+=back
=head2 DlogS_$level
my $pals_rs = DlogS_debug { "pals resultset: $_" }
$schema->resultset('Pals')->search({ perlers => 1 });
+=head1 LOGGER CODEREF
+
+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, 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.
+
+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 $l2 = ...;
+ my $l3 = ...;
+
+ my %registry = (
+ -logger => $l3,
+ A1 => {
+ -logger => $l1,
+ lol => $l2,
+ },
+ A2 => { -logger => $l2 },
+ );
+
+ sub {
+ my ( $package, $info ) = @_;
+
+ my $logger = $registry{'-logger'};
+ if (my $r = $registry{$package}) {
+ $logger = $r->{'-logger'} if $r->{'-logger'};
+ my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1);
+ $sub =~ s/^\Q$package\E:://g;
+ $logger = $r->{$sub} if $r->{$sub};
+ }
+ return $logger;
+ }
+ };
+
+ set_logger $complex_dispatcher;
+
=head1 LOGGER INTERFACE
Because this module is ultimately pretty looking glue (glittery?) with the
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) 2010 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