1 package Log::Contextual;
6 our $VERSION = '0.00201';
9 use Data::Dumper::Concise;
10 use Scalar::Util 'blessed';
12 BEGIN { our @ISA = qw(Exporter) }
15 Dlog_debug DlogS_debug
16 Dlog_trace DlogS_trace
19 Dlog_error DlogS_error
20 Dlog_fatal DlogS_fatal
34 qw( set_logger with_logger )
45 die 'Log::Contextual does not have a default import list'
48 for my $idx ( 0 .. $#_ ) {
50 if ( defined $val && $val eq '-logger' ) {
51 set_logger($_[$idx + 1]);
53 } elsif ( defined $val && $val eq '-default_logger' ) {
54 _set_default_logger_for(scalar caller, $_[$idx + 1]);
58 $package->export_to_level(1, $package, @_);
64 sub _set_default_logger_for {
66 if(ref $logger ne 'CODE') {
67 die 'logger was not a CodeRef or a logger object. Please try again.'
68 unless blessed($logger);
69 $logger = do { my $l = $logger; sub { $l } }
71 $Default_Logger{$_[0]} = $logger
78 $Default_Logger{$package} ||
79 die q( no logger set! you can't try to log something without a logger! )
85 if(ref $logger ne 'CODE') {
86 die 'logger was not a CodeRef or a logger object. Please try again.'
87 unless blessed($logger);
88 $logger = do { my $l = $logger; sub { $l } }
91 warn 'set_logger (or -logger) called more than once! This is a bad idea!'
93 $Get_Logger = $logger;
98 if(ref $logger ne 'CODE') {
99 die 'logger was not a CodeRef or a logger object. Please try again.'
100 unless blessed($logger);
101 $logger = do { my $l = $logger; sub { $l } }
103 local $Get_Logger = $logger;
110 my $log = _get_logger( caller );
112 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
113 $log->trace($code->(@_))
119 my $log = _get_logger( caller );
121 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
122 $log->debug($code->(@_))
128 my $log = _get_logger( caller );
130 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
131 $log->info($code->(@_))
137 my $log = _get_logger( caller );
139 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
140 $log->warn($code->(@_))
146 my $log = _get_logger( caller );
148 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
149 $log->error($code->(@_))
155 my $log = _get_logger( caller );
157 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
158 $log->fatal($code->(@_))
164 sub logS_trace (&$) {
165 my $log = _get_logger( caller );
168 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
169 $log->trace($code->($value))
174 sub logS_debug (&$) {
175 my $log = _get_logger( caller );
178 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
179 $log->debug($code->($value))
185 my $log = _get_logger( caller );
188 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
189 $log->info($code->($value))
195 my $log = _get_logger( caller );
198 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
199 $log->warn($code->($value))
204 sub logS_error (&$) {
205 my $log = _get_logger( caller );
208 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
209 $log->error($code->($value))
214 sub logS_fatal (&$) {
215 my $log = _get_logger( caller );
218 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 1;
219 $log->fatal($code->($value))
226 sub Dlog_trace (&@) {
231 do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
233 do { local $_ = '()'; $code->() };
238 sub Dlog_debug (&@) {
243 do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
245 do { local $_ = '()'; $code->() };
255 do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
257 do { local $_ = '()'; $code->() };
267 do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
269 do { local $_ = '()'; $code->() };
274 sub Dlog_error (&@) {
279 do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
281 do { local $_ = '()'; $code->() };
286 sub Dlog_fatal (&@) {
291 do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
293 do { local $_ = '()'; $code->() };
300 sub DlogS_trace (&$) {
304 do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
308 sub DlogS_debug (&$) {
312 do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
316 sub DlogS_info (&$) {
320 do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
324 sub DlogS_warn (&$) {
328 do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
332 sub DlogS_error (&$) {
336 do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
340 sub DlogS_fatal (&$) {
344 do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
354 Log::Contextual - Simple logging interface with a contextual log
358 use Log::Contextual qw( :log :dlog set_logger with_logger );
359 use Log::Contextual::SimpleLogger;
360 use Log::Log4perl ':easy';
361 Log::Log4perl->easy_init($DEBUG);
364 my $logger = Log::Log4perl->get_logger;
368 log_debug { 'program started' };
371 with_logger(Log::Contextual::SimpleLogger->new({
372 levels => [qw( trace debug )]
374 log_trace { 'foo entered' };
375 my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
377 log_trace { 'foo left' };
383 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
384 with C<Log::Contextual>:
386 use Log::Contextual qw( :log :dlog set_logger );
387 use Log::Dispatchouli;
388 my $ld = Log::Dispatchouli->new({
389 ident => 'slrtbrfst',
396 log_debug { 'program started' };
400 This module is a simple interface to extensible logging. It is bundled with a
401 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
402 should use a real logger instead of that. For something more serious but not
403 overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
409 When you import this module you may use C<-logger> as a shortcut for
410 L<set_logger>, for example:
412 use Log::Contextual::SimpleLogger;
413 use Log::Contextual qw( :dlog ),
414 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
416 sometimes you might want to have the logger handy for other stuff, in which
417 case you might try something like the following:
420 BEGIN { $var_log = VarLogger->new }
421 use Log::Contextual qw( :dlog ), -logger => $var_log;
423 =head2 -default_logger
425 The C<-default_logger> import option is similar to the C<-logger> import option
426 except C<-default_logger> sets the the default logger for the current package.
428 Basically it sets the logger to be used if C<set_logger> is never called; so
431 use Log::Contextual::SimpleLogger;
432 use Log::Contextual qw( :log ),
433 -default_logger => Log::Contextual::WarnLogger->new({
434 env_prefix => 'MY_PACKAGE'
437 If you are interested in using this package for a module you are putting on
438 CPAN we recommend L<Log::Contextual::WarnLogger> for your default logger.
440 =head1 A WORK IN PROGRESS
442 This module is certainly not complete, but we will not break the interface
443 lightly, so I would say it's safe to use in production code. The main result
444 from that at this point is that doing:
448 will die as we do not yet know what the defaults should be. If it turns out
449 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
450 probably make C<:log> the default. But only time and usage will tell.
456 my $logger = WarnLogger->new;
459 Arguments: C<Ref|CodeRef $returning_logger>
461 C<set_logger> will just set the current logger to whatever you pass it. It
462 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
463 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
464 top-level script. To avoid foot-shooting the function will warn if you call it
469 my $logger = WarnLogger->new;
470 with_logger $logger => sub {
472 log_fatal { 'Non Logical Universe Detected' };
474 log_info { 'All is good' };
478 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
480 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
481 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
482 C<CodeRef> if needed.
488 Arguments: C<CodeRef $returning_message, @args>
490 All of the following six functions work the same except that a different method
491 is called on the underlying C<$logger> object. The basic pattern is:
493 sub log_$level (&@) {
494 if ($logger->is_$level) {
495 $logger->$level(shift->(@_));
500 Note that the function returns it's arguments. This can be used in a number of
501 ways, but often it's convenient just for partial inspection of passthrough data
503 my @friends = log_trace {
504 'friends list being generated, data from first friend: ' .
505 Dumper($_[0]->TO_JSON)
506 } generate_friend_list();
508 If you want complete inspection of passthrough data, take a look at the
509 L</Dlog_$level> functions.
513 log_trace { 'entered method foo with args ' join q{,}, @args };
517 log_debug { 'entered method foo' };
521 log_info { 'started process foo' };
525 log_warn { 'possible misconfiguration at line 10' };
529 log_error { 'non-numeric user input!' };
533 log_fatal { '1 is never equal to 0!' };
539 Arguments: C<CodeRef $returning_message, Item $arg>
541 This is really just a special case of the L</log_$level> functions. It forces
542 scalar context when that is what you need. Other than that it works exactly
545 my $friend = logS_trace {
546 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
549 See also: L</DlogS_$level>.
555 Arguments: C<CodeRef $returning_message, @args>
557 All of the following six functions work the same as their L</log_$level>
558 brethren, except they return what is passed into them and put the stringified
559 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
560 you can do cool things like the following:
562 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
564 and the output might look something like:
574 my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
578 Dlog_debug { "random data structure: $_" } { foo => $bar };
582 return Dlog_info { "html from method returned: $_" } "<html>...</html>";
586 Dlog_warn { "probably invalid value: $_" } $foo;
590 Dlog_error { "non-numeric user input! ($_)" } $port;
594 Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
600 Arguments: C<CodeRef $returning_message, Item $arg>
602 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
603 They only take a single scalar after the C<$returning_message> instead of
604 slurping up (and also setting C<wantarray>) all the C<@args>
606 my $pals_rs = DlogS_debug { "pals resultset: $_" }
607 $schema->resultset('Pals')->search({ perlers => 1 });
609 =head1 LOGGER INTERFACE
611 Because this module is ultimately pretty looking glue (glittery?) with the
612 awesome benefit of the Contextual part, users will often want to make their
613 favorite logger work with it. The following are the methods that should be
614 implemented in the logger:
629 The first six merely need to return true if that level is enabled. The latter
630 six take the results of whatever the user returned from their coderef and log
631 them. For a basic example see L<Log::Contextual::SimpleLogger>.
635 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
639 mst - Matt S. Trout <mst@shadowcat.co.uk>
643 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
648 This library is free software and may be distributed under the same terms as