1 package Log::Contextual;
6 our $VERSION = '0.00303';
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
33 require Log::Log4perl;
34 die if $Log::Log4perl::VERSION < 1.29;
35 Log::Log4perl->wrapper_register(__PACKAGE__)
40 qw( set_logger with_logger )
51 die 'Log::Contextual does not have a default import list'
54 for my $idx ( 0 .. $#_ ) {
56 if ( defined $val && $val eq '-logger' ) {
57 set_logger($_[$idx + 1]);
59 } elsif ( defined $val && $val eq '-package_logger' ) {
60 _set_package_logger_for(scalar caller, $_[$idx + 1]);
62 } elsif ( defined $val && $val eq '-default_logger' ) {
63 _set_default_logger_for(scalar caller, $_[$idx + 1]);
67 $package->export_to_level(1, $package, @_);
74 sub _set_default_logger_for {
76 if(ref $logger ne 'CODE') {
77 die 'logger was not a CodeRef or a logger object. Please try again.'
78 unless blessed($logger);
79 $logger = do { my $l = $logger; sub { $l } }
81 $Default_Logger{$_[0]} = $logger
84 sub _set_package_logger_for {
86 if(ref $logger ne 'CODE') {
87 die 'logger was not a CodeRef or a logger object. Please try again.'
88 unless blessed($logger);
89 $logger = do { my $l = $logger; sub { $l } }
91 $Package_Logger{$_[0]} = $logger
97 $Package_Logger{$package} ||
99 $Default_Logger{$package} ||
100 die q( no logger set! you can't try to log something without a logger! )
106 if(ref $logger ne 'CODE') {
107 die 'logger was not a CodeRef or a logger object. Please try again.'
108 unless blessed($logger);
109 $logger = do { my $l = $logger; sub { $l } }
112 warn 'set_logger (or -logger) called more than once! This is a bad idea!'
114 $Get_Logger = $logger;
119 if(ref $logger ne 'CODE') {
120 die 'logger was not a CodeRef or a logger object. Please try again.'
121 unless blessed($logger);
122 $logger = do { my $l = $logger; sub { $l } }
124 local $Get_Logger = $logger;
134 $logger->$level($code->(@_))
135 if $logger->${\"is_$level"};
145 $logger->$level($code->($value))
146 if $logger->${\"is_$level"};
150 sub log_trace (&@) { _do_log( trace => _get_logger( caller ), shift @_, @_) }
151 sub log_debug (&@) { _do_log( debug => _get_logger( caller ), shift @_, @_) }
152 sub log_info (&@) { _do_log( info => _get_logger( caller ), shift @_, @_) }
153 sub log_warn (&@) { _do_log( warn => _get_logger( caller ), shift @_, @_) }
154 sub log_error (&@) { _do_log( error => _get_logger( caller ), shift @_, @_) }
155 sub log_fatal (&@) { _do_log( fatal => _get_logger( caller ), shift @_, @_) }
157 sub logS_trace (&$) { _do_logS( trace => _get_logger( caller ), $_[0], $_[1]) }
158 sub logS_debug (&$) { _do_logS( debug => _get_logger( caller ), $_[0], $_[1]) }
159 sub logS_info (&$) { _do_logS( info => _get_logger( caller ), $_[0], $_[1]) }
160 sub logS_warn (&$) { _do_logS( warn => _get_logger( caller ), $_[0], $_[1]) }
161 sub logS_error (&$) { _do_logS( error => _get_logger( caller ), $_[0], $_[1]) }
162 sub logS_fatal (&$) { _do_logS( fatal => _get_logger( caller ), $_[0], $_[1]) }
165 sub Dlog_trace (&@) {
167 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
168 return _do_log( trace => _get_logger( caller ), $code, @_ );
171 sub Dlog_debug (&@) {
173 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
174 return _do_log( debug => _get_logger( caller ), $code, @_ );
179 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
180 return _do_log( info => _get_logger( caller ), $code, @_ );
185 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
186 return _do_log( warn => _get_logger( caller ), $code, @_ );
189 sub Dlog_error (&@) {
191 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
192 return _do_log( error => _get_logger( caller ), $code, @_ );
195 sub Dlog_fatal (&@) {
197 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
198 return _do_log( fatal => _get_logger( caller ), $code, @_ );
202 sub DlogS_trace (&$) {
203 local $_ = Data::Dumper::Concise::Dumper $_[1];
204 _do_logS( trace => _get_logger( caller ), $_[0], $_[1] )
207 sub DlogS_debug (&$) {
208 local $_ = Data::Dumper::Concise::Dumper $_[1];
209 _do_logS( debug => _get_logger( caller ), $_[0], $_[1] )
212 sub DlogS_info (&$) {
213 local $_ = Data::Dumper::Concise::Dumper $_[1];
214 _do_logS( info => _get_logger( caller ), $_[0], $_[1] )
217 sub DlogS_warn (&$) {
218 local $_ = Data::Dumper::Concise::Dumper $_[1];
219 _do_logS( warn => _get_logger( caller ), $_[0], $_[1] )
222 sub DlogS_error (&$) {
223 local $_ = Data::Dumper::Concise::Dumper $_[1];
224 _do_logS( error => _get_logger( caller ), $_[0], $_[1] )
227 sub DlogS_fatal (&$) {
228 local $_ = Data::Dumper::Concise::Dumper $_[1];
229 _do_logS( fatal => _get_logger( caller ), $_[0], $_[1] )
238 Log::Contextual - Simple logging interface with a contextual log
242 use Log::Contextual qw( :log :dlog set_logger with_logger );
243 use Log::Contextual::SimpleLogger;
244 use Log::Log4perl ':easy';
245 Log::Log4perl->easy_init($DEBUG);
248 my $logger = Log::Log4perl->get_logger;
252 log_debug { 'program started' };
255 with_logger(Log::Contextual::SimpleLogger->new({
256 levels => [qw( trace debug )]
258 log_trace { 'foo entered' };
259 my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
261 log_trace { 'foo left' };
267 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
268 with C<Log::Contextual>:
270 use Log::Contextual qw( :log :dlog set_logger );
271 use Log::Dispatchouli;
272 my $ld = Log::Dispatchouli->new({
273 ident => 'slrtbrfst',
280 log_debug { 'program started' };
284 This module is a simple interface to extensible logging. It is bundled with a
285 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
286 should use a real logger instead of that. For something more serious but not
287 overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
293 When you import this module you may use C<-logger> as a shortcut for
294 L<set_logger>, for example:
296 use Log::Contextual::SimpleLogger;
297 use Log::Contextual qw( :dlog ),
298 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
300 sometimes you might want to have the logger handy for other stuff, in which
301 case you might try something like the following:
304 BEGIN { $var_log = VarLogger->new }
305 use Log::Contextual qw( :dlog ), -logger => $var_log;
307 =head2 -package_logger
309 The C<-package_logger> import option is similar to the C<-logger> import option
310 except C<-package_logger> sets the the logger for the current package.
312 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
316 use Log::Contextual::SimpleLogger;
317 use Log::Contextual qw( :log ),
318 -package_logger => Log::Contextual::WarnLogger->new({
319 env_prefix => 'MY_PACKAGE'
322 If you are interested in using this package for a module you are putting on
323 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
325 =head2 -default_logger
327 The C<-default_logger> import option is similar to the C<-logger> import option
328 except C<-default_logger> sets the the B<default> logger for the current package.
330 Basically it sets the logger to be used if C<set_logger> is never called; so
333 use Log::Contextual::SimpleLogger;
334 use Log::Contextual qw( :log ),
335 -default_logger => Log::Contextual::WarnLogger->new({
336 env_prefix => 'MY_PACKAGE'
339 =head1 A WORK IN PROGRESS
341 This module is certainly not complete, but we will not break the interface
342 lightly, so I would say it's safe to use in production code. The main result
343 from that at this point is that doing:
347 will die as we do not yet know what the defaults should be. If it turns out
348 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
349 probably make C<:log> the default. But only time and usage will tell.
355 my $logger = WarnLogger->new;
358 Arguments: C<Ref|CodeRef $returning_logger>
360 C<set_logger> will just set the current logger to whatever you pass it. It
361 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
362 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
363 top-level script. To avoid foot-shooting the function will warn if you call it
368 my $logger = WarnLogger->new;
369 with_logger $logger => sub {
371 log_fatal { 'Non Logical Universe Detected' };
373 log_info { 'All is good' };
377 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
379 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
380 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
381 C<CodeRef> if needed.
387 Arguments: C<CodeRef $returning_message, @args>
389 All of the following six functions work the same except that a different method
390 is called on the underlying C<$logger> object. The basic pattern is:
392 sub log_$level (&@) {
393 if ($logger->is_$level) {
394 $logger->$level(shift->(@_));
399 Note that the function returns it's arguments. This can be used in a number of
400 ways, but often it's convenient just for partial inspection of passthrough data
402 my @friends = log_trace {
403 'friends list being generated, data from first friend: ' .
404 Dumper($_[0]->TO_JSON)
405 } generate_friend_list();
407 If you want complete inspection of passthrough data, take a look at the
408 L</Dlog_$level> functions.
412 log_trace { 'entered method foo with args ' join q{,}, @args };
416 log_debug { 'entered method foo' };
420 log_info { 'started process foo' };
424 log_warn { 'possible misconfiguration at line 10' };
428 log_error { 'non-numeric user input!' };
432 log_fatal { '1 is never equal to 0!' };
438 Arguments: C<CodeRef $returning_message, Item $arg>
440 This is really just a special case of the L</log_$level> functions. It forces
441 scalar context when that is what you need. Other than that it works exactly
444 my $friend = logS_trace {
445 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
448 See also: L</DlogS_$level>.
454 Arguments: C<CodeRef $returning_message, @args>
456 All of the following six functions work the same as their L</log_$level>
457 brethren, except they return what is passed into them and put the stringified
458 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
459 you can do cool things like the following:
461 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
463 and the output might look something like:
473 my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
477 Dlog_debug { "random data structure: $_" } { foo => $bar };
481 return Dlog_info { "html from method returned: $_" } "<html>...</html>";
485 Dlog_warn { "probably invalid value: $_" } $foo;
489 Dlog_error { "non-numeric user input! ($_)" } $port;
493 Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
499 Arguments: C<CodeRef $returning_message, Item $arg>
501 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
502 They only take a single scalar after the C<$returning_message> instead of
503 slurping up (and also setting C<wantarray>) all the C<@args>
505 my $pals_rs = DlogS_debug { "pals resultset: $_" }
506 $schema->resultset('Pals')->search({ perlers => 1 });
508 =head1 LOGGER INTERFACE
510 Because this module is ultimately pretty looking glue (glittery?) with the
511 awesome benefit of the Contextual part, users will often want to make their
512 favorite logger work with it. The following are the methods that should be
513 implemented in the logger:
528 The first six merely need to return true if that level is enabled. The latter
529 six take the results of whatever the user returned from their coderef and log
530 them. For a basic example see L<Log::Contextual::SimpleLogger>.
534 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
538 mst - Matt S. Trout <mst@shadowcat.co.uk>
542 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
547 This library is free software and may be distributed under the same terms as