1 package Log::Contextual;
6 our $VERSION = '0.00202';
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;
113 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 2;
114 $logger->$level($code->(@_))
115 if $logger->${\"is_$level"};
125 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 2;
126 $logger->$level($code->($value))
127 if $logger->${\"is_$level"};
131 sub log_trace (&@) { _do_log( trace => _get_logger( caller ), shift @_, @_) }
132 sub log_debug (&@) { _do_log( debug => _get_logger( caller ), shift @_, @_) }
133 sub log_info (&@) { _do_log( info => _get_logger( caller ), shift @_, @_) }
134 sub log_warn (&@) { _do_log( warn => _get_logger( caller ), shift @_, @_) }
135 sub log_error (&@) { _do_log( error => _get_logger( caller ), shift @_, @_) }
136 sub log_fatal (&@) { _do_log( fatal => _get_logger( caller ), shift @_, @_) }
138 sub logS_trace (&$) { _do_logS( trace => _get_logger( caller ), $_[0], $_[1]) }
139 sub logS_debug (&$) { _do_logS( debug => _get_logger( caller ), $_[0], $_[1]) }
140 sub logS_info (&$) { _do_logS( info => _get_logger( caller ), $_[0], $_[1]) }
141 sub logS_warn (&$) { _do_logS( warn => _get_logger( caller ), $_[0], $_[1]) }
142 sub logS_error (&$) { _do_logS( error => _get_logger( caller ), $_[0], $_[1]) }
143 sub logS_fatal (&$) { _do_logS( fatal => _get_logger( caller ), $_[0], $_[1]) }
146 sub Dlog_trace (&@) {
148 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
149 return _do_log( trace => _get_logger( caller ), $code, @_ );
152 sub Dlog_debug (&@) {
154 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
155 return _do_log( debug => _get_logger( caller ), $code, @_ );
160 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
161 return _do_log( info => _get_logger( caller ), $code, @_ );
166 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
167 return _do_log( warn => _get_logger( caller ), $code, @_ );
170 sub Dlog_error (&@) {
172 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
173 return _do_log( error => _get_logger( caller ), $code, @_ );
176 sub Dlog_fatal (&@) {
178 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
179 return _do_log( fatal => _get_logger( caller ), $code, @_ );
183 sub DlogS_trace (&$) {
184 local $_ = Data::Dumper::Concise::Dumper $_[1];
185 _do_logS( trace => _get_logger( caller ), $_[0], $_[1] )
188 sub DlogS_debug (&$) {
189 local $_ = Data::Dumper::Concise::Dumper $_[1];
190 _do_logS( debug => _get_logger( caller ), $_[0], $_[1] )
193 sub DlogS_info (&$) {
194 local $_ = Data::Dumper::Concise::Dumper $_[1];
195 _do_logS( info => _get_logger( caller ), $_[0], $_[1] )
198 sub DlogS_warn (&$) {
199 local $_ = Data::Dumper::Concise::Dumper $_[1];
200 _do_logS( warn => _get_logger( caller ), $_[0], $_[1] )
203 sub DlogS_error (&$) {
204 local $_ = Data::Dumper::Concise::Dumper $_[1];
205 _do_logS( error => _get_logger( caller ), $_[0], $_[1] )
208 sub DlogS_fatal (&$) {
209 local $_ = Data::Dumper::Concise::Dumper $_[1];
210 _do_logS( fatal => _get_logger( caller ), $_[0], $_[1] )
219 Log::Contextual - Simple logging interface with a contextual log
223 use Log::Contextual qw( :log :dlog set_logger with_logger );
224 use Log::Contextual::SimpleLogger;
225 use Log::Log4perl ':easy';
226 Log::Log4perl->easy_init($DEBUG);
229 my $logger = Log::Log4perl->get_logger;
233 log_debug { 'program started' };
236 with_logger(Log::Contextual::SimpleLogger->new({
237 levels => [qw( trace debug )]
239 log_trace { 'foo entered' };
240 my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
242 log_trace { 'foo left' };
248 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
249 with C<Log::Contextual>:
251 use Log::Contextual qw( :log :dlog set_logger );
252 use Log::Dispatchouli;
253 my $ld = Log::Dispatchouli->new({
254 ident => 'slrtbrfst',
261 log_debug { 'program started' };
265 This module is a simple interface to extensible logging. It is bundled with a
266 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
267 should use a real logger instead of that. For something more serious but not
268 overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
274 When you import this module you may use C<-logger> as a shortcut for
275 L<set_logger>, for example:
277 use Log::Contextual::SimpleLogger;
278 use Log::Contextual qw( :dlog ),
279 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
281 sometimes you might want to have the logger handy for other stuff, in which
282 case you might try something like the following:
285 BEGIN { $var_log = VarLogger->new }
286 use Log::Contextual qw( :dlog ), -logger => $var_log;
288 =head2 -default_logger
290 The C<-default_logger> import option is similar to the C<-logger> import option
291 except C<-default_logger> sets the the default logger for the current package.
293 Basically it sets the logger to be used if C<set_logger> is never called; so
296 use Log::Contextual::SimpleLogger;
297 use Log::Contextual qw( :log ),
298 -default_logger => Log::Contextual::WarnLogger->new({
299 env_prefix => 'MY_PACKAGE'
302 If you are interested in using this package for a module you are putting on
303 CPAN we recommend L<Log::Contextual::WarnLogger> for your default logger.
305 =head1 A WORK IN PROGRESS
307 This module is certainly not complete, but we will not break the interface
308 lightly, so I would say it's safe to use in production code. The main result
309 from that at this point is that doing:
313 will die as we do not yet know what the defaults should be. If it turns out
314 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
315 probably make C<:log> the default. But only time and usage will tell.
321 my $logger = WarnLogger->new;
324 Arguments: C<Ref|CodeRef $returning_logger>
326 C<set_logger> will just set the current logger to whatever you pass it. It
327 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
328 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
329 top-level script. To avoid foot-shooting the function will warn if you call it
334 my $logger = WarnLogger->new;
335 with_logger $logger => sub {
337 log_fatal { 'Non Logical Universe Detected' };
339 log_info { 'All is good' };
343 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
345 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
346 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
347 C<CodeRef> if needed.
353 Arguments: C<CodeRef $returning_message, @args>
355 All of the following six functions work the same except that a different method
356 is called on the underlying C<$logger> object. The basic pattern is:
358 sub log_$level (&@) {
359 if ($logger->is_$level) {
360 $logger->$level(shift->(@_));
365 Note that the function returns it's arguments. This can be used in a number of
366 ways, but often it's convenient just for partial inspection of passthrough data
368 my @friends = log_trace {
369 'friends list being generated, data from first friend: ' .
370 Dumper($_[0]->TO_JSON)
371 } generate_friend_list();
373 If you want complete inspection of passthrough data, take a look at the
374 L</Dlog_$level> functions.
378 log_trace { 'entered method foo with args ' join q{,}, @args };
382 log_debug { 'entered method foo' };
386 log_info { 'started process foo' };
390 log_warn { 'possible misconfiguration at line 10' };
394 log_error { 'non-numeric user input!' };
398 log_fatal { '1 is never equal to 0!' };
404 Arguments: C<CodeRef $returning_message, Item $arg>
406 This is really just a special case of the L</log_$level> functions. It forces
407 scalar context when that is what you need. Other than that it works exactly
410 my $friend = logS_trace {
411 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
414 See also: L</DlogS_$level>.
420 Arguments: C<CodeRef $returning_message, @args>
422 All of the following six functions work the same as their L</log_$level>
423 brethren, except they return what is passed into them and put the stringified
424 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
425 you can do cool things like the following:
427 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
429 and the output might look something like:
439 my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
443 Dlog_debug { "random data structure: $_" } { foo => $bar };
447 return Dlog_info { "html from method returned: $_" } "<html>...</html>";
451 Dlog_warn { "probably invalid value: $_" } $foo;
455 Dlog_error { "non-numeric user input! ($_)" } $port;
459 Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
465 Arguments: C<CodeRef $returning_message, Item $arg>
467 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
468 They only take a single scalar after the C<$returning_message> instead of
469 slurping up (and also setting C<wantarray>) all the C<@args>
471 my $pals_rs = DlogS_debug { "pals resultset: $_" }
472 $schema->resultset('Pals')->search({ perlers => 1 });
474 =head1 LOGGER INTERFACE
476 Because this module is ultimately pretty looking glue (glittery?) with the
477 awesome benefit of the Contextual part, users will often want to make their
478 favorite logger work with it. The following are the methods that should be
479 implemented in the logger:
494 The first six merely need to return true if that level is enabled. The latter
495 six take the results of whatever the user returned from their coderef and log
496 them. For a basic example see L<Log::Contextual::SimpleLogger>.
500 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
504 mst - Matt S. Trout <mst@shadowcat.co.uk>
508 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
513 This library is free software and may be distributed under the same terms as