1 package Log::Contextual;
6 our $VERSION = '0.005004';
7 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
9 my @levels = qw(debug trace warn info error fatal);
11 use Exporter::Declare;
12 use Exporter::Declare::Export::Generator;
13 use Data::Dumper::Concise;
14 use Scalar::Util 'blessed';
16 my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
18 my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
21 require Log::Log4perl;
22 die if $Log::Log4perl::VERSION < 1.29;
23 Log::Log4perl->wrapper_register(__PACKAGE__)
26 # ____ is because tags must have at least one export and we don't want to
27 # export anything but the levels selected
32 qw( set_logger with_logger )
35 export_tag dlog => ('____');
36 export_tag log => ('____');
37 import_arguments qw(logger package_logger default_logger);
40 our $Router_Instance ||= do {
41 require Log::Contextual::Router;
42 Log::Contextual::Router->new
49 die 'Log::Contextual does not have a default import list';
54 sub arg_logger { $_[1] }
55 sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
56 sub arg_package_logger { $_[1] }
57 sub arg_default_logger { $_[1] }
60 my ($class, $importer, $spec) = @_;
61 my $router = $class->router;
62 my $exports = $spec->exports;
66 arguments => $spec->argument_info
69 my @tags = $class->default_import($spec)
70 if $spec->config->{default};
73 die "only tags are supported for defaults at this time"
74 unless $_ =~ /^:(.*)$/;
76 $spec->config->{$1} = 1;
79 $router->before_import(%router_args);
81 if ($exports->{'&set_logger'}) {
82 die ref($router) . " does not support set_logger()"
83 unless $router->does('Log::Contextual::Role::Router::SetLogger');
85 $spec->add_export('&set_logger', sub { $router->set_logger(@_) })
88 if ($exports->{'&with_logger'}) {
89 die ref($router) . " does not support with_logger()"
90 unless $router->does('Log::Contextual::Role::Router::WithLogger');
92 $spec->add_export('&with_logger', sub { $router->with_logger(@_) })
95 my @levels = @{$class->arg_levels($spec->config->{levels})};
96 for my $level (@levels) {
97 if ($spec->config->{log} || $exports->{"&log_$level"}) {
101 my ($code, @args) = @_;
102 $router->handle_log_request(
104 caller_package => scalar(caller),
106 message_level => $level,
107 message_sub => $code,
108 message_args => \@args,
113 if ($spec->config->{log} || $exports->{"&logS_$level"}) {
117 my ($code, @args) = @_;
118 $router->handle_log_request(
120 caller_package => scalar(caller),
122 message_level => $level,
123 message_sub => $code,
124 message_args => \@args,
129 if ($spec->config->{dlog} || $exports->{"&Dlog_$level"}) {
133 my ($code, @args) = @_;
135 local $_ = (@_ ? Data::Dumper::Concise::Dumper @_ : '()');
138 $router->handle_log_request(
140 caller_package => scalar(caller),
142 message_level => $level,
143 message_sub => $wrapped,
144 message_args => \@args,
149 if ($spec->config->{dlog} || $exports->{"&DlogS_$level"}) {
153 my ($code, $ref) = @_;
155 local $_ = Data::Dumper::Concise::Dumper($_[0]);
158 $router->handle_log_request(
160 caller_package => scalar(caller),
162 message_level => $level,
163 message_sub => $wrapped,
164 message_args => [$ref],
173 my ($class, $importer, $spec) = @_;
177 arguments => $spec->argument_info
179 $class->router->after_import(%router_args);
184 my $sub = "${_}_logger";
185 *{"Log::Contextual::$sub"} = sub {
186 die "$sub is no longer a direct sub in Log::Contextual. " .
187 'Note that this feature was never tested nor documented. ' .
188 "Please fix your code to import $sub instead of trying to use it directly"
198 Log::Contextual - Simple logging interface with a contextual log
202 use Log::Contextual qw( :log :dlog set_logger with_logger );
203 use Log::Contextual::SimpleLogger;
204 use Log::Log4perl ':easy';
205 Log::Log4perl->easy_init($DEBUG);
207 my $logger = Log::Log4perl->get_logger;
211 log_debug { 'program started' };
215 my $minilogger = Log::Contextual::SimpleLogger->new({
216 levels => [qw( trace debug )]
221 with_logger $minilogger => sub {
222 log_trace { 'foo entered' };
223 my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @args;
225 log_trace { 'foo left' };
231 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
232 with C<Log::Contextual>:
234 use Log::Contextual qw( :log :dlog set_logger );
235 use Log::Dispatchouli;
236 my $ld = Log::Dispatchouli->new({
237 ident => 'slrtbrfst',
244 log_debug { 'program started' };
254 The logging functions take blocks, so if a log level is disabled, the
257 # the following won't run if debug is off
258 log_debug { "the new count in the database is " . $rs->count };
260 Similarly, the C<D> prefixed methods only C<Dumper> the input if the level is
265 The logging functions return their arguments, so you can stick them in
266 the middle of expressions:
268 for (log_debug { "downloading:\n" . join qq(\n), @_ } @urls) { ... }
272 C<Log::Contextual> is an interface for all major loggers. If you log through
273 C<Log::Contextual> you will be able to swap underlying loggers later.
277 C<Log::Contextual> chooses which logger to use based on L<< user defined C<CodeRef>s|/LOGGER CODEREF >>.
278 Normally you don't need to know this, but you can take advantage of it when you
283 If you just want to add logging to your extremely basic application, start with
284 L<Log::Contextual::SimpleLogger> and then as your needs grow you can switch to
285 L<Log::Dispatchouli> or L<Log::Dispatch> or L<Log::Log4perl> or whatever else.
289 This module is a simple interface to extensible logging. It exists to
290 abstract your logging interface so that logging is as painless as possible,
291 while still allowing you to switch from one logger to another.
293 It is bundled with a really basic logger, L<Log::Contextual::SimpleLogger>,
294 but in general you should use a real logger instead of that. For something
295 more serious but not overly complicated, try L<Log::Dispatchouli> (see
296 L</SYNOPSIS> for example.)
298 =head1 A WORK IN PROGRESS
300 This module is certainly not complete, but we will not break the interface
301 lightly, so I would say it's safe to use in production code. The main result
302 from that at this point is that doing:
306 will die as we do not yet know what the defaults should be. If it turns out
307 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
308 probably make C<:log> the default. But only time and usage will tell.
310 =head1 IMPORT OPTIONS
312 See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
317 When you import this module you may use C<-logger> as a shortcut for
318 L<set_logger>, for example:
320 use Log::Contextual::SimpleLogger;
321 use Log::Contextual qw( :dlog ),
322 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
324 sometimes you might want to have the logger handy for other stuff, in which
325 case you might try something like the following:
328 BEGIN { $var_log = VarLogger->new }
329 use Log::Contextual qw( :dlog ), -logger => $var_log;
333 The C<-levels> import option allows you to define exactly which levels your
334 logger supports. So the default,
335 C<< [qw(debug trace warn info error fatal)] >>, works great for
336 L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>. But
337 supporting those levels is as easy as doing
340 -levels => [qw( debug info notice warning error critical alert emergency )];
342 =head2 -package_logger
344 The C<-package_logger> import option is similar to the C<-logger> import option
345 except C<-package_logger> sets the logger for the current package.
347 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
351 use Log::Contextual::SimpleLogger;
352 use Log::Contextual qw( :log ),
353 -package_logger => Log::Contextual::WarnLogger->new({
354 env_prefix => 'MY_PACKAGE'
357 If you are interested in using this package for a module you are putting on
358 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
360 =head2 -default_logger
362 The C<-default_logger> import option is similar to the C<-logger> import option
363 except C<-default_logger> sets the B<default> logger for the current package.
365 Basically it sets the logger to be used if C<set_logger> is never called; so
368 use Log::Contextual::SimpleLogger;
369 use Log::Contextual qw( :log ),
370 -default_logger => Log::Contextual::WarnLogger->new({
371 env_prefix => 'MY_PACKAGE'
374 =head1 SETTING DEFAULT IMPORT OPTIONS
376 Eventually you will get tired of writing the following in every single one of
380 use Log::Log4perl ':easy';
381 BEGIN { Log::Log4perl->easy_init($DEBUG) }
383 use Log::Contextual -logger => Log::Log4perl->get_logger;
385 You can set any of the import options for your whole project if you define your
386 own C<Log::Contextual> subclass as follows:
388 package MyApp::Log::Contextual;
390 use base 'Log::Contextual';
392 use Log::Log4perl ':easy';
393 Log::Log4perl->easy_init($DEBUG)
395 sub arg_default_logger { $_[1] || Log::Log4perl->get_logger }
396 sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
397 sub default_import { ':log' }
399 # or maybe instead of default_logger
400 sub arg_package_logger { $_[1] }
402 # and almost definitely not this, which is only here for completeness
403 sub arg_logger { $_[1] }
405 Note the C<< $_[1] || >> in C<arg_default_logger>. All of these methods are
406 passed the values passed in from the arguments to the subclass, so you can
407 either throw them away, honor them, die on usage, or whatever. To be clear,
408 if you define your subclass, and someone uses it as follows:
410 use MyApp::Log::Contextual -default_logger => $foo,
411 -levels => [qw(bar baz biff)];
413 Your C<arg_default_logger> method will get C<$foo> and your C<arg_levels>
414 will get C<[qw(bar baz biff)]>;
416 Additionally, the C<default_import> method is what happens if a user tries to
417 use your subclass with no arguments. The default just dies, but if you'd like
418 to change the default to import a tag merely return the tags you'd like to
419 import. So the following will all work:
421 sub default_import { ':log' }
423 sub default_import { ':dlog' }
425 sub default_import { qw(:dlog :log ) }
431 my $logger = WarnLogger->new;
434 Arguments: L</LOGGER CODEREF>
436 C<set_logger> will just set the current logger to whatever you pass it. It
437 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
438 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
439 top-level script. To avoid foot-shooting the function will warn if you call it
444 my $logger = WarnLogger->new;
445 with_logger $logger => sub {
447 log_fatal { 'Non Logical Universe Detected' };
449 log_info { 'All is good' };
453 Arguments: L</LOGGER CODEREF>, C<CodeRef $to_execute>
455 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
456 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
457 C<CodeRef> if needed.
463 Arguments: C<CodeRef $returning_message, @args>
465 C<log_$level> functions all work the same except that a different method
466 is called on the underlying C<$logger> object. The basic pattern is:
468 sub log_$level (&@) {
469 if ($logger->is_$level) {
470 $logger->$level(shift->(@_));
475 Note that the function returns it's arguments. This can be used in a number of
476 ways, but often it's convenient just for partial inspection of passthrough data
478 my @friends = log_trace {
479 'friends list being generated, data from first friend: ' .
480 Dumper($_[0]->TO_JSON)
481 } generate_friend_list();
483 If you want complete inspection of passthrough data, take a look at the
484 L</Dlog_$level> functions.
486 Which functions are exported depends on what was passed to L</-levels>. The
487 default (no C<-levels> option passed) would export:
509 Arguments: C<CodeRef $returning_message, Item $arg>
511 This is really just a special case of the L</log_$level> functions. It forces
512 scalar context when that is what you need. Other than that it works exactly
515 my $friend = logS_trace {
516 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
519 See also: L</DlogS_$level>.
525 Arguments: C<CodeRef $returning_message, @args>
527 All of the following six functions work the same as their L</log_$level>
528 brethren, except they return what is passed into them and put the stringified
529 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
530 you can do cool things like the following:
532 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
534 and the output might look something like:
542 Which functions are exported depends on what was passed to L</-levels>. The
543 default (no C<-levels> option passed) would export:
565 Arguments: C<CodeRef $returning_message, Item $arg>
567 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
568 They only take a single scalar after the C<$returning_message> instead of
569 slurping up (and also setting C<wantarray>) all the C<@args>
571 my $pals_rs = DlogS_debug { "pals resultset: $_" }
572 $schema->resultset('Pals')->search({ perlers => 1 });
574 =head1 LOGGER CODEREF
576 Anywhere a logger object can be passed, a coderef is accepted. This is so
577 that the user can use different logger objects based on runtime information.
578 The logger coderef is passed the package of the caller the caller level the
579 coderef needs to use if it wants more caller information. The latter is in
580 a hashref to allow for more options in the future.
582 Here is a basic example of a logger that exploits C<caller> to reproduce the
583 output of C<warn> with a logger:
586 my $var_log = Log::Contextual::SimpleLogger->new({
587 levels => [qw(trace debug info warn error fatal)],
588 coderef => sub { chomp($_[0]); warn "$_[0] at $caller_info[1] line $caller_info[2].\n" }
590 my $warn_faker = sub {
591 my ($package, $args) = @_;
592 @caller_info = caller($args->{caller_level});
595 set_logger($warn_faker);
596 log_debug { 'test' };
598 The following is an example that uses the information passed to the logger
599 coderef. It sets the global logger to C<$l3>, the logger for the C<A1>
600 package to C<$l1>, except the C<lol> method in C<A1> which uses the C<$l2>
601 logger and lastly the logger for the C<A2> package to C<$l2>.
603 Note that it increases the caller level as it dispatches based on where
604 the caller of the log function, not the log function itself.
606 my $complex_dispatcher = do {
618 A2 => { -logger => $l2 },
622 my ( $package, $info ) = @_;
624 my $logger = $registry{'-logger'};
625 if (my $r = $registry{$package}) {
626 $logger = $r->{'-logger'} if $r->{'-logger'};
627 my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1);
628 $sub =~ s/^\Q$package\E:://g;
629 $logger = $r->{$sub} if $r->{$sub};
635 set_logger $complex_dispatcher;
637 =head1 LOGGER INTERFACE
639 Because this module is ultimately pretty looking glue (glittery?) with the
640 awesome benefit of the Contextual part, users will often want to make their
641 favorite logger work with it. The following are the methods that should be
642 implemented in the logger:
657 The first six merely need to return true if that level is enabled. The latter
658 six take the results of whatever the user returned from their coderef and log
659 them. For a basic example see L<Log::Contextual::SimpleLogger>.
663 In between the loggers and the log functions is a log router that is responsible for
664 finding a logger to handle the log event and passing the log information to the
665 logger. This relationship is described in the documentation for C<Log::Contextual::Role::Router>.
667 C<Log::Contextual> and packages that extend it will by default share a router singleton that
668 implements the with_logger() and set_logger() functions and also respects the -logger,
669 -package_logger, and -default_logger import options with their associated default value
670 functions. The router singleton is available as the return value of the router() function. Users
671 of Log::Contextual may overload router() to return instances of custom log routers that
672 could for example work with loggers that use a different interface.
676 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
680 triddle - Tyler Riddle <t.riddle@shadowcat.co.uk>
684 mst - Matt S. Trout <mst@shadowcat.co.uk>
688 Copyright (c) 2012 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
693 This library is free software and may be distributed under the same terms as