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