rename arg_router to router as it's not an argument
[p5sagit/Log-Contextual.git] / lib / Log / Contextual.pm
CommitLineData
0daa11f3 1package Log::Contextual;
2
a2777569 3use strict;
4use warnings;
2033c911 5
0c180ced 6our $VERSION = '0.004202';
2033c911 7
ae9785e2 8my @levels = qw(debug trace warn info error fatal);
9
675503c7 10use Exporter::Declare;
11use Exporter::Declare::Export::Generator;
f11f9542 12use Data::Dumper::Concise;
5b094c87 13use Scalar::Util 'blessed';
2033c911 14
ae9785e2 15my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
16
17my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
f11f9542 18
b144ba01 19eval {
20 require Log::Log4perl;
21 die if $Log::Log4perl::VERSION < 1.29;
22 Log::Log4perl->wrapper_register(__PACKAGE__)
23};
24
5fd26f45 25# ____ is because tags must have at least one export and we don't want to
26# export anything but the levels selected
27sub ____ {}
28
29exports ('____',
f11f9542 30 @dlog, @log,
9b8e24d5 31 qw( set_logger with_logger )
f11f9542 32);
33
5fd26f45 34export_tag dlog => ('____');
35export_tag log => ('____');
675503c7 36import_arguments qw(logger package_logger default_logger);
37
139ded54 38sub router {
0092c26a 39 our $Router_Instance ||= do {
40 require Log::Contextual::Router;
41 Log::Contextual::Router->new
42 }
43}
44
8112b699 45sub arg_logger { $_[1] }
46sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
47sub arg_package_logger { $_[1] }
48sub arg_default_logger { $_[1] }
49
675503c7 50sub before_import {
51 my ($class, $importer, $spec) = @_;
139ded54 52 my $router = $class->router;
4d605164 53 my $exports = $spec->exports;
f11f9542 54
f11f9542 55 die 'Log::Contextual does not have a default import list'
675503c7 56 if $spec->config->{default};
57
8112b699 58 $router->before_import(@_);
59
4d605164 60 $spec->add_export('&set_logger', sub {
139ded54 61 my $router = $class->router;
4d605164 62
63 die ref($router) . " does not support set_logger()"
64 unless $router->does('Log::Contextual::Role::Router::SetLogger');
65
66 return $router->set_logger(@_);
67 }) if $exports->{'&set_logger'};
68
69 $spec->add_export('&with_logger', sub {
139ded54 70 my $router = $class->router;
4d605164 71
72 die ref($router) . " does not support with_logger()"
73 unless $router->does('Log::Contextual::Role::Router::WithLogger');
74
75 return $router->with_logger(@_);
76 }) if $exports->{'&with_logger'};
77
5fd26f45 78 my @levels = @{$class->arg_levels($spec->config->{levels})};
675503c7 79 for my $level (@levels) {
80 if ($spec->config->{log}) {
81 $spec->add_export("&log_$level", sub (&@) {
8112b699 82 my ($code, @args) = @_;
8527bf52 83 $router->handle_log_request({
84 package => scalar(caller),
85 caller_level => 1,
86 level => $level,
87 }, $code, @args);
8112b699 88 return @args;
675503c7 89 });
90 $spec->add_export("&logS_$level", sub (&@) {
8527bf52 91 my ($code, @args) = @_;
92 $router->handle_log_request({
93 package => scalar(caller),
94 caller_level => 1,
95 level => $level,
96 }, $code, @args);
97 return $args[0];
675503c7 98 });
99 }
100 if ($spec->config->{dlog}) {
101 $spec->add_export("&Dlog_$level", sub (&@) {
8112b699 102 my ($code, @args) = @_;
8527bf52 103 my $wrapped = sub {
104 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
105 &$code;
106 };
107 $router->handle_log_request({
108 package => scalar(caller),
109 caller_level => 1,
110 level => $level,
111 }, $wrapped, @args);
8112b699 112 return @args;
675503c7 113 });
114 $spec->add_export("&DlogS_$level", sub (&$) {
8112b699 115 my ($code, $ref) = @_;
8527bf52 116 my $wrapped = sub {
117 local $_ = Data::Dumper::Concise::Dumper($_[0]);
118 &$code;
119 };
120 $router->handle_log_request({
121 package => scalar(caller),
122 caller_level => 1,
123 level => $level,
124 }, $wrapped, $ref);
8112b699 125 return $ref;
675503c7 126 });
a2777569 127 }
128 }
675503c7 129}
130
139ded54 131sub after_import { $_[0]->router->after_import(@_) }
709d11fe 132
0daa11f3 1331;
0a3750e2 134
135__END__
136
2daff231 137=head1 NAME
138
8bc568d2 139Log::Contextual - Simple logging interface with a contextual log
2daff231 140
141=head1 SYNOPSIS
142
9b8e24d5 143 use Log::Contextual qw( :log :dlog set_logger with_logger );
5b094c87 144 use Log::Contextual::SimpleLogger;
145 use Log::Log4perl ':easy';
146 Log::Log4perl->easy_init($DEBUG);
2daff231 147
5b094c87 148 my $logger = Log::Log4perl->get_logger;
149
150 set_logger $logger;
2daff231 151
9b8e24d5 152 log_debug { 'program started' };
2daff231 153
154 sub foo {
f9bf084b 155
156 my $minilogger = Log::Contextual::SimpleLogger->new({
157 levels => [qw( trace debug )]
158 });
159
160 with_logger $minilogger => sub {
21431192 161 log_trace { 'foo entered' };
9b8e24d5 162 my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
2daff231 163 # ...
21431192 164 log_trace { 'foo left' };
f9bf084b 165 };
2daff231 166 }
167
5b094c87 168 foo();
169
9fe4eeb3 170Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
171with C<Log::Contextual>:
172
173 use Log::Contextual qw( :log :dlog set_logger );
174 use Log::Dispatchouli;
175 my $ld = Log::Dispatchouli->new({
176 ident => 'slrtbrfst',
177 to_stderr => 1,
178 debug => 1,
179 });
180
181 set_logger $ld;
182
183 log_debug { 'program started' };
184
2daff231 185=head1 DESCRIPTION
186
30d7027a 187Major benefits:
188
189=over 2
190
191=item * Efficient
192
193The logging functions take blocks, so if a log level is disabled, the
194block will not run:
195
196 # the following won't run if debug is off
197 log_debug { "the new count in the database is " . $rs->count };
198
199Similarly, the C<D> prefixed methods only C<Dumper> the input if the level is
200enabled.
201
202=item * Handy
203
204The logging functions return their arguments, so you can stick them in
205the middle of expressions:
206
207 for (log_debug { "downloading:\n" . join qq(\n), @_ } @urls) { ... }
208
209=item * Generic
210
211C<Log::Contextual> is an interface for all major loggers. If you log through
212C<Log::Contextual> you will be able to swap underlying loggers later.
213
214=item * Powerful
215
39cd2f65 216C<Log::Contextual> chooses which logger to use based on L<< user defined C<CodeRef>s|/LOGGER CODEREF >>.
30d7027a 217Normally you don't need to know this, but you can take advantage of it when you
218need to later
219
220=item * Scalable
221
222If you just want to add logging to your extremely basic application, start with
223L<Log::Contextual::SimpleLogger> and then as your needs grow you can switch to
224L<Log::Dispatchouli> or L<Log::Dispatch> or L<Log::Log4perl> or whatever else.
225
226=back
227
228This module is a simple interface to extensible logging. It exists to
229abstract your logging interface so that logging is as painless as possible,
230while still allowing you to switch from one logger to another.
3dc9bd3c 231
30d7027a 232It is bundled with a really basic logger, L<Log::Contextual::SimpleLogger>,
233but in general you should use a real logger instead of that. For something
234more serious but not overly complicated, try L<Log::Dispatchouli> (see
235L</SYNOPSIS> for example.)
a2af6976 236
e36f2183 237=head1 A WORK IN PROGRESS
238
239This module is certainly not complete, but we will not break the interface
240lightly, so I would say it's safe to use in production code. The main result
241from that at this point is that doing:
242
243 use Log::Contextual;
244
245will die as we do not yet know what the defaults should be. If it turns out
246that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
247probably make C<:log> the default. But only time and usage will tell.
248
249=head1 IMPORT OPTIONS
250
251See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
252wide.
3dc9bd3c 253
c154d18a 254=head2 -logger
255
3dc9bd3c 256When you import this module you may use C<-logger> as a shortcut for
257L<set_logger>, for example:
258
259 use Log::Contextual::SimpleLogger;
9b8e24d5 260 use Log::Contextual qw( :dlog ),
261 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
3dc9bd3c 262
263sometimes you might want to have the logger handy for other stuff, in which
264case you might try something like the following:
265
266 my $var_log;
267 BEGIN { $var_log = VarLogger->new }
9b8e24d5 268 use Log::Contextual qw( :dlog ), -logger => $var_log;
3dc9bd3c 269
5fd26f45 270=head2 -levels
271
272The C<-levels> import option allows you to define exactly which levels your
273logger supports. So the default,
274C<< [qw(debug trace warn info error fatal)] >>, works great for
275L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>. But
276supporting those levels is as easy as doing
277
278 use Log::Contextual
279 -levels => [qw( debug info notice warning error critical alert emergency )];
280
e2b4b29c 281=head2 -package_logger
282
283The C<-package_logger> import option is similar to the C<-logger> import option
284except C<-package_logger> sets the the logger for the current package.
285
286Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
287L</set_logger>.
288
289 package My::Package;
290 use Log::Contextual::SimpleLogger;
291 use Log::Contextual qw( :log ),
292 -package_logger => Log::Contextual::WarnLogger->new({
293 env_prefix => 'MY_PACKAGE'
294 });
295
296If you are interested in using this package for a module you are putting on
297CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
298
c154d18a 299=head2 -default_logger
300
301The C<-default_logger> import option is similar to the C<-logger> import option
e2b4b29c 302except C<-default_logger> sets the the B<default> logger for the current package.
c154d18a 303
304Basically it sets the logger to be used if C<set_logger> is never called; so
305
306 package My::Package;
307 use Log::Contextual::SimpleLogger;
308 use Log::Contextual qw( :log ),
309 -default_logger => Log::Contextual::WarnLogger->new({
ae59bbe3 310 env_prefix => 'MY_PACKAGE'
c154d18a 311 });
312
e36f2183 313=head1 SETTING DEFAULT IMPORT OPTIONS
3dc9bd3c 314
e36f2183 315Eventually you will get tired of writing the following in every single one of
316your packages:
3dc9bd3c 317
e36f2183 318 use Log::Log4perl;
319 use Log::Log4perl ':easy';
320 BEGIN { Log::Log4perl->easy_init($DEBUG) }
3dc9bd3c 321
e36f2183 322 use Log::Contextual -logger => Log::Log4perl->get_logger;
323
324You can set any of the import options for your whole project if you define your
325own C<Log::Contextual> subclass as follows:
326
327 package MyApp::Log::Contextual;
328
329 use base 'Log::Contextual';
330
331 use Log::Log4perl ':easy';
332 Log::Log4perl->easy_init($DEBUG)
333
2b40dee5 334 sub arg_default_logger { $_[1] || Log::Log4perl->get_logger }
e36f2183 335 sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
336
2b40dee5 337 # or maybe instead of default_logger
e36f2183 338 sub arg_package_logger { $_[1] }
e36f2183 339
2b40dee5 340 # and almost definitely not this, which is only here for completeness
341 sub arg_logger { $_[1] }
e36f2183 342
2b40dee5 343Note the C<< $_[1] || >> in C<arg_default_logger>. All of these methods are
344passed the values passed in from the arguments to the subclass, so you can
345either throw them away, honor them, die on usage, or whatever. To be clear,
346if you define your subclass, and someone uses it as follows:
e36f2183 347
2b40dee5 348 use MyApp::Log::Contextual -default_logger => $foo,
349 -levels => [qw(bar baz biff)];
350
351Your C<arg_default_logger> method will get C<$foo> and your C<arg_levels>
e36f2183 352will get C<[qw(bar baz biff)]>;
2daff231 353
354=head1 FUNCTIONS
355
356=head2 set_logger
357
358 my $logger = WarnLogger->new;
21431192 359 set_logger $logger;
360
27141a7a 361Arguments: L</LOGGER CODEREF>
2daff231 362
21431192 363C<set_logger> will just set the current logger to whatever you pass it. It
364expects a C<CodeRef>, but if you pass it something else it will wrap it in a
06e908c3 365C<CodeRef> for you. C<set_logger> is really meant only to be called from a
366top-level script. To avoid foot-shooting the function will warn if you call it
367more than once.
2daff231 368
369=head2 with_logger
370
371 my $logger = WarnLogger->new;
21431192 372 with_logger $logger => sub {
2daff231 373 if (1 == 0) {
374 log_fatal { 'Non Logical Universe Detected' };
375 } else {
376 log_info { 'All is good' };
377 }
80c3e48b 378 };
2daff231 379
27141a7a 380Arguments: L</LOGGER CODEREF>, C<CodeRef $to_execute>
2daff231 381
21431192 382C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
0e13e261 383As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
21431192 384C<CodeRef> if needed.
2daff231 385
21431192 386=head2 log_$level
2daff231 387
0e13e261 388Import Tag: C<:log>
3dc9bd3c 389
0e13e261 390Arguments: C<CodeRef $returning_message, @args>
2daff231 391
a4d67519 392C<log_$level> functions all work the same except that a different method
21431192 393is called on the underlying C<$logger> object. The basic pattern is:
2daff231 394
0e13e261 395 sub log_$level (&@) {
21431192 396 if ($logger->is_$level) {
0e13e261 397 $logger->$level(shift->(@_));
21431192 398 }
0e13e261 399 @_
21431192 400 }
2daff231 401
0e13e261 402Note that the function returns it's arguments. This can be used in a number of
403ways, but often it's convenient just for partial inspection of passthrough data
404
405 my @friends = log_trace {
406 'friends list being generated, data from first friend: ' .
407 Dumper($_[0]->TO_JSON)
408 } generate_friend_list();
409
410If you want complete inspection of passthrough data, take a look at the
411L</Dlog_$level> functions.
412
a4d67519 413Which functions are exported depends on what was passed to L</-levels>. The
414default (no C<-levels> option passed) would export:
2daff231 415
a4d67519 416=over 2
2daff231 417
a4d67519 418=item log_trace
2daff231 419
a4d67519 420=item log_debug
2daff231 421
a4d67519 422=item log_info
2daff231 423
a4d67519 424=item log_warn
2daff231 425
a4d67519 426=item log_error
2daff231 427
a4d67519 428=item log_fatal
2daff231 429
a4d67519 430=back
2daff231 431
0e13e261 432=head2 logS_$level
433
434Import Tag: C<:log>
435
436Arguments: C<CodeRef $returning_message, Item $arg>
437
438This is really just a special case of the L</log_$level> functions. It forces
439scalar context when that is what you need. Other than that it works exactly
440same:
441
442 my $friend = logS_trace {
443 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
444 } friend();
445
446See also: L</DlogS_$level>.
447
21431192 448=head2 Dlog_$level
449
0e13e261 450Import Tag: C<:dlog>
3dc9bd3c 451
0e13e261 452Arguments: C<CodeRef $returning_message, @args>
2daff231 453
0e13e261 454All of the following six functions work the same as their L</log_$level>
9b8e24d5 455brethren, except they return what is passed into them and put the stringified
21431192 456(with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
457you can do cool things like the following:
458
459 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
460
461and the output might look something like:
462
463 names: "fREW"
464 "fRIOUX"
465 "fROOH"
466 "fRUE"
467 "fiSMBoC"
468
a4d67519 469Which functions are exported depends on what was passed to L</-levels>. The
470default (no C<-levels> option passed) would export:
21431192 471
a4d67519 472=over 2
21431192 473
a4d67519 474=item Dlog_trace
21431192 475
a4d67519 476=item Dlog_debug
21431192 477
a4d67519 478=item Dlog_info
21431192 479
a4d67519 480=item Dlog_warn
21431192 481
a4d67519 482=item Dlog_error
2daff231 483
a4d67519 484=item Dlog_fatal
2daff231 485
a4d67519 486=back
2daff231 487
83b33eb5 488=head2 DlogS_$level
489
0e13e261 490Import Tag: C<:dlog>
3dc9bd3c 491
0e13e261 492Arguments: C<CodeRef $returning_message, Item $arg>
83b33eb5 493
0e13e261 494Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
495They only take a single scalar after the C<$returning_message> instead of
496slurping up (and also setting C<wantarray>) all the C<@args>
83b33eb5 497
498 my $pals_rs = DlogS_debug { "pals resultset: $_" }
499 $schema->resultset('Pals')->search({ perlers => 1 });
500
27141a7a 501=head1 LOGGER CODEREF
502
503Anywhere a logger object can be passed, a coderef is accepted. This is so
504that the user can use different logger objects based on runtime information.
505The logger coderef is passed the package of the caller the caller level the
506coderef needs to use if it wants more caller information. The latter is in
507a hashref to allow for more options in the future.
508
37a8266a 509Here is a basic example of a logger that exploits C<caller> to reproduce the
510output of C<warn> with a logger:
511
512 my @caller_info;
513 my $var_log = Log::Contextual::SimpleLogger->new({
514 levels => [qw(trace debug info warn error fatal)],
515 coderef => sub { chomp($_[0]); warn "$_[0] at $caller_info[1] line $caller_info[2].\n" }
516 });
517 my $warn_faker = sub {
518 my ($package, $args) = @_;
519 @caller_info = caller($args->{caller_level});
520 $var_log
521 };
522 set_logger($warn_faker);
523 log_debug { 'test' };
524
27141a7a 525The following is an example that uses the information passed to the logger
526coderef. It sets the global logger to C<$l3>, the logger for the C<A1>
527package to C<$l1>, except the C<lol> method in C<A1> which uses the C<$l2>
528logger and lastly the logger for the C<A2> package to C<$l2>.
529
37a8266a 530Note that it increases the caller level as it dispatches based on where
531the caller of the log function, not the log function itself.
532
27141a7a 533 my $complex_dispatcher = do {
534
535 my $l1 = ...;
536 my $l2 = ...;
537 my $l3 = ...;
538
539 my %registry = (
540 -logger => $l3,
541 A1 => {
542 -logger => $l1,
543 lol => $l2,
544 },
545 A2 => { -logger => $l2 },
546 );
547
548 sub {
549 my ( $package, $info ) = @_;
550
551 my $logger = $registry{'-logger'};
552 if (my $r = $registry{$package}) {
553 $logger = $r->{'-logger'} if $r->{'-logger'};
37a8266a 554 my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1);
27141a7a 555 $sub =~ s/^\Q$package\E:://g;
556 $logger = $r->{$sub} if $r->{$sub};
557 }
558 return $logger;
559 }
560 };
561
562 set_logger $complex_dispatcher;
563
3dc9bd3c 564=head1 LOGGER INTERFACE
565
566Because this module is ultimately pretty looking glue (glittery?) with the
567awesome benefit of the Contextual part, users will often want to make their
568favorite logger work with it. The following are the methods that should be
569implemented in the logger:
570
571 is_trace
572 is_debug
573 is_info
574 is_warn
575 is_error
576 is_fatal
577 trace
578 debug
579 info
580 warn
581 error
582 fatal
583
584The first six merely need to return true if that level is enabled. The latter
585six take the results of whatever the user returned from their coderef and log
586them. For a basic example see L<Log::Contextual::SimpleLogger>.
587
2daff231 588=head1 AUTHOR
589
590frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
591
592=head1 DESIGNER
593
594mst - Matt S. Trout <mst@shadowcat.co.uk>
595
596=head1 COPYRIGHT
597
a6e29e27 598Copyright (c) 2012 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
2daff231 599above.
600
601=head1 LICENSE
602
603This library is free software and may be distributed under the same terms as
604Perl 5 itself.
605
606=cut
607