1 package Log::Contextual;
6 our $VERSION = '0.004100';
8 my @levels = qw(debug trace warn info error fatal);
10 use Exporter::Declare;
11 use Exporter::Declare::Export::Generator;
12 use Data::Dumper::Concise;
13 use Scalar::Util 'blessed';
15 my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
17 my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
20 require Log::Log4perl;
21 die if $Log::Log4perl::VERSION < 1.29;
22 Log::Log4perl->wrapper_register(__PACKAGE__)
25 # ____ is because tags must have at least one export and we don't want to
26 # export anything but the levels selected
31 qw( set_logger with_logger )
34 export_tag dlog => ('____');
35 export_tag log => ('____');
36 import_arguments qw(logger package_logger default_logger);
39 my ($class, $importer, $spec) = @_;
41 die 'Log::Contextual does not have a default import list'
42 if $spec->config->{default};
44 my @levels = @{$class->arg_levels($spec->config->{levels})};
45 for my $level (@levels) {
46 if ($spec->config->{log}) {
47 $spec->add_export("&log_$level", sub (&@) {
48 _do_log( $level => _get_logger( caller ), shift @_, @_)
50 $spec->add_export("&logS_$level", sub (&@) {
51 _do_logS( $level => _get_logger( caller ), $_[0], $_[1])
54 if ($spec->config->{dlog}) {
55 $spec->add_export("&Dlog_$level", sub (&@) {
56 my ($code, @args) = @_;
57 return _do_log( $level => _get_logger( caller ), sub {
58 local $_ = (@args?Data::Dumper::Concise::Dumper @args:'()');
62 $spec->add_export("&DlogS_$level", sub (&$) {
63 my ($code, $ref) = @_;
64 _do_logS( $level => _get_logger( caller ), sub {
65 local $_ = Data::Dumper::Concise::Dumper $ref;
73 sub arg_logger { $_[1] }
74 sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
75 sub arg_package_logger { $_[1] }
76 sub arg_default_logger { $_[1] }
79 my ($class, $importer, $specs) = @_;
81 if (my $l = $class->arg_logger($specs->config->{logger})) {
85 if (my $l = $class->arg_package_logger($specs->config->{package_logger})) {
86 _set_package_logger_for($importer, $l)
89 if (my $l = $class->arg_default_logger($specs->config->{default_logger})) {
90 _set_default_logger_for($importer, $l)
98 sub _set_default_logger_for {
100 if(ref $logger ne 'CODE') {
101 die 'logger was not a CodeRef or a logger object. Please try again.'
102 unless blessed($logger);
103 $logger = do { my $l = $logger; sub { $l } }
105 $Default_Logger{$_[0]} = $logger
108 sub _set_package_logger_for {
110 if(ref $logger ne 'CODE') {
111 die 'logger was not a CodeRef or a logger object. Please try again.'
112 unless blessed($logger);
113 $logger = do { my $l = $logger; sub { $l } }
115 $Package_Logger{$_[0]} = $logger
121 $Package_Logger{$package} ||
123 $Default_Logger{$package} ||
124 die q( no logger set! you can't try to log something without a logger! )
125 )->($package, { caller_level => 3 });
130 if(ref $logger ne 'CODE') {
131 die 'logger was not a CodeRef or a logger object. Please try again.'
132 unless blessed($logger);
133 $logger = do { my $l = $logger; sub { $l } }
136 warn 'set_logger (or -logger) called more than once! This is a bad idea!'
138 $Get_Logger = $logger;
143 if(ref $logger ne 'CODE') {
144 die 'logger was not a CodeRef or a logger object. Please try again.'
145 unless blessed($logger);
146 $logger = do { my $l = $logger; sub { $l } }
148 local $Get_Logger = $logger;
158 $logger->$level($code->(@_))
159 if $logger->${\"is_$level"};
169 $logger->$level($code->($value))
170 if $logger->${\"is_$level"};
180 Log::Contextual - Simple logging interface with a contextual log
184 use Log::Contextual qw( :log :dlog set_logger with_logger );
185 use Log::Contextual::SimpleLogger;
186 use Log::Log4perl ':easy';
187 Log::Log4perl->easy_init($DEBUG);
189 my $logger = Log::Log4perl->get_logger;
193 log_debug { 'program started' };
197 my $minilogger = Log::Contextual::SimpleLogger->new({
198 levels => [qw( trace debug )]
201 with_logger $minilogger => sub {
202 log_trace { 'foo entered' };
203 my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
205 log_trace { 'foo left' };
211 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
212 with C<Log::Contextual>:
214 use Log::Contextual qw( :log :dlog set_logger );
215 use Log::Dispatchouli;
216 my $ld = Log::Dispatchouli->new({
217 ident => 'slrtbrfst',
224 log_debug { 'program started' };
234 The logging functions take blocks, so if a log level is disabled, the
237 # the following won't run if debug is off
238 log_debug { "the new count in the database is " . $rs->count };
240 Similarly, the C<D> prefixed methods only C<Dumper> the input if the level is
245 The logging functions return their arguments, so you can stick them in
246 the middle of expressions:
248 for (log_debug { "downloading:\n" . join qq(\n), @_ } @urls) { ... }
252 C<Log::Contextual> is an interface for all major loggers. If you log through
253 C<Log::Contextual> you will be able to swap underlying loggers later.
257 C<Log::Contextual> chooses which logger to use based on L<< user defined C<CodeRef>s|/LOGGER CODEREF>>.
258 Normally you don't need to know this, but you can take advantage of it when you
263 If you just want to add logging to your extremely basic application, start with
264 L<Log::Contextual::SimpleLogger> and then as your needs grow you can switch to
265 L<Log::Dispatchouli> or L<Log::Dispatch> or L<Log::Log4perl> or whatever else.
269 This module is a simple interface to extensible logging. It exists to
270 abstract your logging interface so that logging is as painless as possible,
271 while still allowing you to switch from one logger to another.
273 It is bundled with a really basic logger, L<Log::Contextual::SimpleLogger>,
274 but in general you should use a real logger instead of that. For something
275 more serious but not overly complicated, try L<Log::Dispatchouli> (see
276 L</SYNOPSIS> for example.)
278 =head1 A WORK IN PROGRESS
280 This module is certainly not complete, but we will not break the interface
281 lightly, so I would say it's safe to use in production code. The main result
282 from that at this point is that doing:
286 will die as we do not yet know what the defaults should be. If it turns out
287 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
288 probably make C<:log> the default. But only time and usage will tell.
290 =head1 IMPORT OPTIONS
292 See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
297 When you import this module you may use C<-logger> as a shortcut for
298 L<set_logger>, for example:
300 use Log::Contextual::SimpleLogger;
301 use Log::Contextual qw( :dlog ),
302 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
304 sometimes you might want to have the logger handy for other stuff, in which
305 case you might try something like the following:
308 BEGIN { $var_log = VarLogger->new }
309 use Log::Contextual qw( :dlog ), -logger => $var_log;
313 The C<-levels> import option allows you to define exactly which levels your
314 logger supports. So the default,
315 C<< [qw(debug trace warn info error fatal)] >>, works great for
316 L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>. But
317 supporting those levels is as easy as doing
320 -levels => [qw( debug info notice warning error critical alert emergency )];
322 =head2 -package_logger
324 The C<-package_logger> import option is similar to the C<-logger> import option
325 except C<-package_logger> sets the the logger for the current package.
327 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
331 use Log::Contextual::SimpleLogger;
332 use Log::Contextual qw( :log ),
333 -package_logger => Log::Contextual::WarnLogger->new({
334 env_prefix => 'MY_PACKAGE'
337 If you are interested in using this package for a module you are putting on
338 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
340 =head2 -default_logger
342 The C<-default_logger> import option is similar to the C<-logger> import option
343 except C<-default_logger> sets the the B<default> logger for the current package.
345 Basically it sets the logger to be used if C<set_logger> is never called; so
348 use Log::Contextual::SimpleLogger;
349 use Log::Contextual qw( :log ),
350 -default_logger => Log::Contextual::WarnLogger->new({
351 env_prefix => 'MY_PACKAGE'
354 =head1 SETTING DEFAULT IMPORT OPTIONS
356 Eventually you will get tired of writing the following in every single one of
360 use Log::Log4perl ':easy';
361 BEGIN { Log::Log4perl->easy_init($DEBUG) }
363 use Log::Contextual -logger => Log::Log4perl->get_logger;
365 You can set any of the import options for your whole project if you define your
366 own C<Log::Contextual> subclass as follows:
368 package MyApp::Log::Contextual;
370 use base 'Log::Contextual';
372 use Log::Log4perl ':easy';
373 Log::Log4perl->easy_init($DEBUG)
375 sub arg_default_logger { $_[1] || Log::Log4perl->get_logger }
376 sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
378 # or maybe instead of default_logger
379 sub arg_package_logger { $_[1] }
381 # and almost definitely not this, which is only here for completeness
382 sub arg_logger { $_[1] }
384 Note the C<< $_[1] || >> in C<arg_default_logger>. All of these methods are
385 passed the values passed in from the arguments to the subclass, so you can
386 either throw them away, honor them, die on usage, or whatever. To be clear,
387 if you define your subclass, and someone uses it as follows:
389 use MyApp::Log::Contextual -default_logger => $foo,
390 -levels => [qw(bar baz biff)];
392 Your C<arg_default_logger> method will get C<$foo> and your C<arg_levels>
393 will get C<[qw(bar baz biff)]>;
399 my $logger = WarnLogger->new;
402 Arguments: L</LOGGER CODEREF>
404 C<set_logger> will just set the current logger to whatever you pass it. It
405 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
406 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
407 top-level script. To avoid foot-shooting the function will warn if you call it
412 my $logger = WarnLogger->new;
413 with_logger $logger => sub {
415 log_fatal { 'Non Logical Universe Detected' };
417 log_info { 'All is good' };
421 Arguments: L</LOGGER CODEREF>, C<CodeRef $to_execute>
423 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
424 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
425 C<CodeRef> if needed.
431 Arguments: C<CodeRef $returning_message, @args>
433 C<log_$level> functions all work the same except that a different method
434 is called on the underlying C<$logger> object. The basic pattern is:
436 sub log_$level (&@) {
437 if ($logger->is_$level) {
438 $logger->$level(shift->(@_));
443 Note that the function returns it's arguments. This can be used in a number of
444 ways, but often it's convenient just for partial inspection of passthrough data
446 my @friends = log_trace {
447 'friends list being generated, data from first friend: ' .
448 Dumper($_[0]->TO_JSON)
449 } generate_friend_list();
451 If you want complete inspection of passthrough data, take a look at the
452 L</Dlog_$level> functions.
454 Which functions are exported depends on what was passed to L</-levels>. The
455 default (no C<-levels> option passed) would export:
477 Arguments: C<CodeRef $returning_message, Item $arg>
479 This is really just a special case of the L</log_$level> functions. It forces
480 scalar context when that is what you need. Other than that it works exactly
483 my $friend = logS_trace {
484 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
487 See also: L</DlogS_$level>.
493 Arguments: C<CodeRef $returning_message, @args>
495 All of the following six functions work the same as their L</log_$level>
496 brethren, except they return what is passed into them and put the stringified
497 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
498 you can do cool things like the following:
500 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
502 and the output might look something like:
510 Which functions are exported depends on what was passed to L</-levels>. The
511 default (no C<-levels> option passed) would export:
533 Arguments: C<CodeRef $returning_message, Item $arg>
535 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
536 They only take a single scalar after the C<$returning_message> instead of
537 slurping up (and also setting C<wantarray>) all the C<@args>
539 my $pals_rs = DlogS_debug { "pals resultset: $_" }
540 $schema->resultset('Pals')->search({ perlers => 1 });
542 =head1 LOGGER CODEREF
544 Anywhere a logger object can be passed, a coderef is accepted. This is so
545 that the user can use different logger objects based on runtime information.
546 The logger coderef is passed the package of the caller the caller level the
547 coderef needs to use if it wants more caller information. The latter is in
548 a hashref to allow for more options in the future.
550 The following is an example that uses the information passed to the logger
551 coderef. It sets the global logger to C<$l3>, the logger for the C<A1>
552 package to C<$l1>, except the C<lol> method in C<A1> which uses the C<$l2>
553 logger and lastly the logger for the C<A2> package to C<$l2>.
555 my $complex_dispatcher = do {
567 A2 => { -logger => $l2 },
571 my ( $package, $info ) = @_;
573 my $logger = $registry{'-logger'};
574 if (my $r = $registry{$package}) {
575 $logger = $r->{'-logger'} if $r->{'-logger'};
576 my (undef, undef, undef, $sub) = caller($info->{caller_level});
577 $sub =~ s/^\Q$package\E:://g;
578 $logger = $r->{$sub} if $r->{$sub};
584 set_logger $complex_dispatcher;
586 =head1 LOGGER INTERFACE
588 Because this module is ultimately pretty looking glue (glittery?) with the
589 awesome benefit of the Contextual part, users will often want to make their
590 favorite logger work with it. The following are the methods that should be
591 implemented in the logger:
606 The first six merely need to return true if that level is enabled. The latter
607 six take the results of whatever the user returned from their coderef and log
608 them. For a basic example see L<Log::Contextual::SimpleLogger>.
612 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
616 mst - Matt S. Trout <mst@shadowcat.co.uk>
620 Copyright (c) 2012 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
625 This library is free software and may be distributed under the same terms as