1 package Log::Contextual;
6 our $VERSION = '0.004202';
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';
14 use Log::Contextual::Router;
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);
39 sub arg_router { return $_[1] if defined $_[1]; our $Router_Instance ||= Log::Contextual::Router->new }
40 sub arg_logger { $_[1] }
41 sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
42 sub arg_package_logger { $_[1] }
43 sub arg_default_logger { $_[1] }
46 my ($class, $importer, $spec) = @_;
47 my $router = $class->arg_router;
49 die 'Log::Contextual does not have a default import list'
50 if $spec->config->{default};
52 $router->before_import(@_);
54 my @levels = @{$class->arg_levels($spec->config->{levels})};
55 for my $level (@levels) {
56 if ($spec->config->{log}) {
57 $spec->add_export("&log_$level", sub (&@) {
58 my ($code, @args) = @_;
59 my @loggers = $router->get_loggers(scalar(caller), $level);
60 foreach my $logger (@loggers) {
61 $logger->$level($code->(@args));
65 $spec->add_export("&logS_$level", sub (&@) {
67 my @loggers = $router->get_loggers(scalar(caller), $level);
68 foreach my $logger (@loggers) {
69 $logger->$level($code->(@_));
74 if ($spec->config->{dlog}) {
75 $spec->add_export("&Dlog_$level", sub (&@) {
76 my ($code, @args) = @_;
77 my $dumped = (@args?Data::Dumper::Concise::Dumper @args:'()');
78 my @loggers = $router->get_loggers(scalar(caller), $level);
79 foreach my $logger (@loggers) {
80 $logger->$level(do { local $_ = $dumped; $code->(@args); });
84 $spec->add_export("&DlogS_$level", sub (&$) {
85 my ($code, $ref) = @_;
86 my $dumped = Data::Dumper::Concise::Dumper $ref;
87 my @loggers = $router->get_loggers(scalar(caller), $level);
88 foreach my $logger (@loggers) {
89 $logger->$level(do { local $_ = $dumped; $code->($ref); });
97 sub after_import { return arg_router()->after_import(@_) }
100 my $router = arg_router();
101 my $meth = $router->can('set_logger');
103 die ref($router) . " does not support set_logger()"
104 unless defined $meth;
106 return $router->$meth(@_);
110 my $router = arg_router();
111 my $meth = $router->can('with_logger');
113 die ref($router) . " does not support with_logger()"
114 unless defined $meth;
116 return $router->$meth(@_);
125 Log::Contextual - Simple logging interface with a contextual log
129 use Log::Contextual qw( :log :dlog set_logger with_logger );
130 use Log::Contextual::SimpleLogger;
131 use Log::Log4perl ':easy';
132 Log::Log4perl->easy_init($DEBUG);
134 my $logger = Log::Log4perl->get_logger;
138 log_debug { 'program started' };
142 my $minilogger = Log::Contextual::SimpleLogger->new({
143 levels => [qw( trace debug )]
146 with_logger $minilogger => sub {
147 log_trace { 'foo entered' };
148 my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
150 log_trace { 'foo left' };
156 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
157 with C<Log::Contextual>:
159 use Log::Contextual qw( :log :dlog set_logger );
160 use Log::Dispatchouli;
161 my $ld = Log::Dispatchouli->new({
162 ident => 'slrtbrfst',
169 log_debug { 'program started' };
179 The logging functions take blocks, so if a log level is disabled, the
182 # the following won't run if debug is off
183 log_debug { "the new count in the database is " . $rs->count };
185 Similarly, the C<D> prefixed methods only C<Dumper> the input if the level is
190 The logging functions return their arguments, so you can stick them in
191 the middle of expressions:
193 for (log_debug { "downloading:\n" . join qq(\n), @_ } @urls) { ... }
197 C<Log::Contextual> is an interface for all major loggers. If you log through
198 C<Log::Contextual> you will be able to swap underlying loggers later.
202 C<Log::Contextual> chooses which logger to use based on L<< user defined C<CodeRef>s|/LOGGER CODEREF >>.
203 Normally you don't need to know this, but you can take advantage of it when you
208 If you just want to add logging to your extremely basic application, start with
209 L<Log::Contextual::SimpleLogger> and then as your needs grow you can switch to
210 L<Log::Dispatchouli> or L<Log::Dispatch> or L<Log::Log4perl> or whatever else.
214 This module is a simple interface to extensible logging. It exists to
215 abstract your logging interface so that logging is as painless as possible,
216 while still allowing you to switch from one logger to another.
218 It is bundled with a really basic logger, L<Log::Contextual::SimpleLogger>,
219 but in general you should use a real logger instead of that. For something
220 more serious but not overly complicated, try L<Log::Dispatchouli> (see
221 L</SYNOPSIS> for example.)
223 =head1 A WORK IN PROGRESS
225 This module is certainly not complete, but we will not break the interface
226 lightly, so I would say it's safe to use in production code. The main result
227 from that at this point is that doing:
231 will die as we do not yet know what the defaults should be. If it turns out
232 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
233 probably make C<:log> the default. But only time and usage will tell.
235 =head1 IMPORT OPTIONS
237 See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
242 When you import this module you may use C<-logger> as a shortcut for
243 L<set_logger>, for example:
245 use Log::Contextual::SimpleLogger;
246 use Log::Contextual qw( :dlog ),
247 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
249 sometimes you might want to have the logger handy for other stuff, in which
250 case you might try something like the following:
253 BEGIN { $var_log = VarLogger->new }
254 use Log::Contextual qw( :dlog ), -logger => $var_log;
258 The C<-levels> import option allows you to define exactly which levels your
259 logger supports. So the default,
260 C<< [qw(debug trace warn info error fatal)] >>, works great for
261 L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>. But
262 supporting those levels is as easy as doing
265 -levels => [qw( debug info notice warning error critical alert emergency )];
267 =head2 -package_logger
269 The C<-package_logger> import option is similar to the C<-logger> import option
270 except C<-package_logger> sets the the logger for the current package.
272 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
276 use Log::Contextual::SimpleLogger;
277 use Log::Contextual qw( :log ),
278 -package_logger => Log::Contextual::WarnLogger->new({
279 env_prefix => 'MY_PACKAGE'
282 If you are interested in using this package for a module you are putting on
283 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
285 =head2 -default_logger
287 The C<-default_logger> import option is similar to the C<-logger> import option
288 except C<-default_logger> sets the the B<default> logger for the current package.
290 Basically it sets the logger to be used if C<set_logger> is never called; so
293 use Log::Contextual::SimpleLogger;
294 use Log::Contextual qw( :log ),
295 -default_logger => Log::Contextual::WarnLogger->new({
296 env_prefix => 'MY_PACKAGE'
299 =head1 SETTING DEFAULT IMPORT OPTIONS
301 Eventually you will get tired of writing the following in every single one of
305 use Log::Log4perl ':easy';
306 BEGIN { Log::Log4perl->easy_init($DEBUG) }
308 use Log::Contextual -logger => Log::Log4perl->get_logger;
310 You can set any of the import options for your whole project if you define your
311 own C<Log::Contextual> subclass as follows:
313 package MyApp::Log::Contextual;
315 use base 'Log::Contextual';
317 use Log::Log4perl ':easy';
318 Log::Log4perl->easy_init($DEBUG)
320 sub arg_default_logger { $_[1] || Log::Log4perl->get_logger }
321 sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
323 # or maybe instead of default_logger
324 sub arg_package_logger { $_[1] }
326 # and almost definitely not this, which is only here for completeness
327 sub arg_logger { $_[1] }
329 Note the C<< $_[1] || >> in C<arg_default_logger>. All of these methods are
330 passed the values passed in from the arguments to the subclass, so you can
331 either throw them away, honor them, die on usage, or whatever. To be clear,
332 if you define your subclass, and someone uses it as follows:
334 use MyApp::Log::Contextual -default_logger => $foo,
335 -levels => [qw(bar baz biff)];
337 Your C<arg_default_logger> method will get C<$foo> and your C<arg_levels>
338 will get C<[qw(bar baz biff)]>;
344 my $logger = WarnLogger->new;
347 Arguments: L</LOGGER CODEREF>
349 C<set_logger> will just set the current logger to whatever you pass it. It
350 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
351 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
352 top-level script. To avoid foot-shooting the function will warn if you call it
357 my $logger = WarnLogger->new;
358 with_logger $logger => sub {
360 log_fatal { 'Non Logical Universe Detected' };
362 log_info { 'All is good' };
366 Arguments: L</LOGGER CODEREF>, C<CodeRef $to_execute>
368 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
369 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
370 C<CodeRef> if needed.
376 Arguments: C<CodeRef $returning_message, @args>
378 C<log_$level> functions all work the same except that a different method
379 is called on the underlying C<$logger> object. The basic pattern is:
381 sub log_$level (&@) {
382 if ($logger->is_$level) {
383 $logger->$level(shift->(@_));
388 Note that the function returns it's arguments. This can be used in a number of
389 ways, but often it's convenient just for partial inspection of passthrough data
391 my @friends = log_trace {
392 'friends list being generated, data from first friend: ' .
393 Dumper($_[0]->TO_JSON)
394 } generate_friend_list();
396 If you want complete inspection of passthrough data, take a look at the
397 L</Dlog_$level> functions.
399 Which functions are exported depends on what was passed to L</-levels>. The
400 default (no C<-levels> option passed) would export:
422 Arguments: C<CodeRef $returning_message, Item $arg>
424 This is really just a special case of the L</log_$level> functions. It forces
425 scalar context when that is what you need. Other than that it works exactly
428 my $friend = logS_trace {
429 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
432 See also: L</DlogS_$level>.
438 Arguments: C<CodeRef $returning_message, @args>
440 All of the following six functions work the same as their L</log_$level>
441 brethren, except they return what is passed into them and put the stringified
442 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
443 you can do cool things like the following:
445 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
447 and the output might look something like:
455 Which functions are exported depends on what was passed to L</-levels>. The
456 default (no C<-levels> option passed) would export:
478 Arguments: C<CodeRef $returning_message, Item $arg>
480 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
481 They only take a single scalar after the C<$returning_message> instead of
482 slurping up (and also setting C<wantarray>) all the C<@args>
484 my $pals_rs = DlogS_debug { "pals resultset: $_" }
485 $schema->resultset('Pals')->search({ perlers => 1 });
487 =head1 LOGGER CODEREF
489 Anywhere a logger object can be passed, a coderef is accepted. This is so
490 that the user can use different logger objects based on runtime information.
491 The logger coderef is passed the package of the caller the caller level the
492 coderef needs to use if it wants more caller information. The latter is in
493 a hashref to allow for more options in the future.
495 Here is a basic example of a logger that exploits C<caller> to reproduce the
496 output of C<warn> with a logger:
499 my $var_log = Log::Contextual::SimpleLogger->new({
500 levels => [qw(trace debug info warn error fatal)],
501 coderef => sub { chomp($_[0]); warn "$_[0] at $caller_info[1] line $caller_info[2].\n" }
503 my $warn_faker = sub {
504 my ($package, $args) = @_;
505 @caller_info = caller($args->{caller_level});
508 set_logger($warn_faker);
509 log_debug { 'test' };
511 The following is an example that uses the information passed to the logger
512 coderef. It sets the global logger to C<$l3>, the logger for the C<A1>
513 package to C<$l1>, except the C<lol> method in C<A1> which uses the C<$l2>
514 logger and lastly the logger for the C<A2> package to C<$l2>.
516 Note that it increases the caller level as it dispatches based on where
517 the caller of the log function, not the log function itself.
519 my $complex_dispatcher = do {
531 A2 => { -logger => $l2 },
535 my ( $package, $info ) = @_;
537 my $logger = $registry{'-logger'};
538 if (my $r = $registry{$package}) {
539 $logger = $r->{'-logger'} if $r->{'-logger'};
540 my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1);
541 $sub =~ s/^\Q$package\E:://g;
542 $logger = $r->{$sub} if $r->{$sub};
548 set_logger $complex_dispatcher;
550 =head1 LOGGER INTERFACE
552 Because this module is ultimately pretty looking glue (glittery?) with the
553 awesome benefit of the Contextual part, users will often want to make their
554 favorite logger work with it. The following are the methods that should be
555 implemented in the logger:
570 The first six merely need to return true if that level is enabled. The latter
571 six take the results of whatever the user returned from their coderef and log
572 them. For a basic example see L<Log::Contextual::SimpleLogger>.
576 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
580 mst - Matt S. Trout <mst@shadowcat.co.uk>
584 Copyright (c) 2012 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
589 This library is free software and may be distributed under the same terms as