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 '-package_logger' ) {
54 _set_package_logger_for(scalar caller, $_[$idx + 1]);
56 } elsif ( defined $val && $val eq '-default_logger' ) {
57 _set_default_logger_for(scalar caller, $_[$idx + 1]);
61 $package->export_to_level(1, $package, @_);
68 sub _set_default_logger_for {
70 if(ref $logger ne 'CODE') {
71 die 'logger was not a CodeRef or a logger object. Please try again.'
72 unless blessed($logger);
73 $logger = do { my $l = $logger; sub { $l } }
75 $Default_Logger{$_[0]} = $logger
78 sub _set_package_logger_for {
80 if(ref $logger ne 'CODE') {
81 die 'logger was not a CodeRef or a logger object. Please try again.'
82 unless blessed($logger);
83 $logger = do { my $l = $logger; sub { $l } }
85 $Package_Logger{$_[0]} = $logger
91 $Package_Logger{$package} ||
93 $Default_Logger{$package} ||
94 die q( no logger set! you can't try to log something without a logger! )
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 } }
106 warn 'set_logger (or -logger) called more than once! This is a bad idea!'
108 $Get_Logger = $logger;
113 if(ref $logger ne 'CODE') {
114 die 'logger was not a CodeRef or a logger object. Please try again.'
115 unless blessed($logger);
116 $logger = do { my $l = $logger; sub { $l } }
118 local $Get_Logger = $logger;
128 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 2;
129 $logger->$level($code->(@_))
130 if $logger->${\"is_$level"};
140 local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 2;
141 $logger->$level($code->($value))
142 if $logger->${\"is_$level"};
146 sub log_trace (&@) { _do_log( trace => _get_logger( caller ), shift @_, @_) }
147 sub log_debug (&@) { _do_log( debug => _get_logger( caller ), shift @_, @_) }
148 sub log_info (&@) { _do_log( info => _get_logger( caller ), shift @_, @_) }
149 sub log_warn (&@) { _do_log( warn => _get_logger( caller ), shift @_, @_) }
150 sub log_error (&@) { _do_log( error => _get_logger( caller ), shift @_, @_) }
151 sub log_fatal (&@) { _do_log( fatal => _get_logger( caller ), shift @_, @_) }
153 sub logS_trace (&$) { _do_logS( trace => _get_logger( caller ), $_[0], $_[1]) }
154 sub logS_debug (&$) { _do_logS( debug => _get_logger( caller ), $_[0], $_[1]) }
155 sub logS_info (&$) { _do_logS( info => _get_logger( caller ), $_[0], $_[1]) }
156 sub logS_warn (&$) { _do_logS( warn => _get_logger( caller ), $_[0], $_[1]) }
157 sub logS_error (&$) { _do_logS( error => _get_logger( caller ), $_[0], $_[1]) }
158 sub logS_fatal (&$) { _do_logS( fatal => _get_logger( caller ), $_[0], $_[1]) }
161 sub Dlog_trace (&@) {
163 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
164 return _do_log( trace => _get_logger( caller ), $code, @_ );
167 sub Dlog_debug (&@) {
169 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
170 return _do_log( debug => _get_logger( caller ), $code, @_ );
175 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
176 return _do_log( info => _get_logger( caller ), $code, @_ );
181 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
182 return _do_log( warn => _get_logger( caller ), $code, @_ );
185 sub Dlog_error (&@) {
187 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
188 return _do_log( error => _get_logger( caller ), $code, @_ );
191 sub Dlog_fatal (&@) {
193 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
194 return _do_log( fatal => _get_logger( caller ), $code, @_ );
198 sub DlogS_trace (&$) {
199 local $_ = Data::Dumper::Concise::Dumper $_[1];
200 _do_logS( trace => _get_logger( caller ), $_[0], $_[1] )
203 sub DlogS_debug (&$) {
204 local $_ = Data::Dumper::Concise::Dumper $_[1];
205 _do_logS( debug => _get_logger( caller ), $_[0], $_[1] )
208 sub DlogS_info (&$) {
209 local $_ = Data::Dumper::Concise::Dumper $_[1];
210 _do_logS( info => _get_logger( caller ), $_[0], $_[1] )
213 sub DlogS_warn (&$) {
214 local $_ = Data::Dumper::Concise::Dumper $_[1];
215 _do_logS( warn => _get_logger( caller ), $_[0], $_[1] )
218 sub DlogS_error (&$) {
219 local $_ = Data::Dumper::Concise::Dumper $_[1];
220 _do_logS( error => _get_logger( caller ), $_[0], $_[1] )
223 sub DlogS_fatal (&$) {
224 local $_ = Data::Dumper::Concise::Dumper $_[1];
225 _do_logS( fatal => _get_logger( caller ), $_[0], $_[1] )
234 Log::Contextual - Simple logging interface with a contextual log
238 use Log::Contextual qw( :log :dlog set_logger with_logger );
239 use Log::Contextual::SimpleLogger;
240 use Log::Log4perl ':easy';
241 Log::Log4perl->easy_init($DEBUG);
244 my $logger = Log::Log4perl->get_logger;
248 log_debug { 'program started' };
251 with_logger(Log::Contextual::SimpleLogger->new({
252 levels => [qw( trace debug )]
254 log_trace { 'foo entered' };
255 my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
257 log_trace { 'foo left' };
263 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
264 with C<Log::Contextual>:
266 use Log::Contextual qw( :log :dlog set_logger );
267 use Log::Dispatchouli;
268 my $ld = Log::Dispatchouli->new({
269 ident => 'slrtbrfst',
276 log_debug { 'program started' };
280 This module is a simple interface to extensible logging. It is bundled with a
281 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
282 should use a real logger instead of that. For something more serious but not
283 overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
289 When you import this module you may use C<-logger> as a shortcut for
290 L<set_logger>, for example:
292 use Log::Contextual::SimpleLogger;
293 use Log::Contextual qw( :dlog ),
294 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
296 sometimes you might want to have the logger handy for other stuff, in which
297 case you might try something like the following:
300 BEGIN { $var_log = VarLogger->new }
301 use Log::Contextual qw( :dlog ), -logger => $var_log;
303 =head2 -package_logger
305 The C<-package_logger> import option is similar to the C<-logger> import option
306 except C<-package_logger> sets the the logger for the current package.
308 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
312 use Log::Contextual::SimpleLogger;
313 use Log::Contextual qw( :log ),
314 -package_logger => Log::Contextual::WarnLogger->new({
315 env_prefix => 'MY_PACKAGE'
318 If you are interested in using this package for a module you are putting on
319 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
321 =head2 -default_logger
323 The C<-default_logger> import option is similar to the C<-logger> import option
324 except C<-default_logger> sets the the B<default> logger for the current package.
326 Basically it sets the logger to be used if C<set_logger> is never called; so
329 use Log::Contextual::SimpleLogger;
330 use Log::Contextual qw( :log ),
331 -default_logger => Log::Contextual::WarnLogger->new({
332 env_prefix => 'MY_PACKAGE'
335 =head1 A WORK IN PROGRESS
337 This module is certainly not complete, but we will not break the interface
338 lightly, so I would say it's safe to use in production code. The main result
339 from that at this point is that doing:
343 will die as we do not yet know what the defaults should be. If it turns out
344 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
345 probably make C<:log> the default. But only time and usage will tell.
351 my $logger = WarnLogger->new;
354 Arguments: C<Ref|CodeRef $returning_logger>
356 C<set_logger> will just set the current logger to whatever you pass it. It
357 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
358 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
359 top-level script. To avoid foot-shooting the function will warn if you call it
364 my $logger = WarnLogger->new;
365 with_logger $logger => sub {
367 log_fatal { 'Non Logical Universe Detected' };
369 log_info { 'All is good' };
373 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
375 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
376 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
377 C<CodeRef> if needed.
383 Arguments: C<CodeRef $returning_message, @args>
385 All of the following six functions work the same except that a different method
386 is called on the underlying C<$logger> object. The basic pattern is:
388 sub log_$level (&@) {
389 if ($logger->is_$level) {
390 $logger->$level(shift->(@_));
395 Note that the function returns it's arguments. This can be used in a number of
396 ways, but often it's convenient just for partial inspection of passthrough data
398 my @friends = log_trace {
399 'friends list being generated, data from first friend: ' .
400 Dumper($_[0]->TO_JSON)
401 } generate_friend_list();
403 If you want complete inspection of passthrough data, take a look at the
404 L</Dlog_$level> functions.
408 log_trace { 'entered method foo with args ' join q{,}, @args };
412 log_debug { 'entered method foo' };
416 log_info { 'started process foo' };
420 log_warn { 'possible misconfiguration at line 10' };
424 log_error { 'non-numeric user input!' };
428 log_fatal { '1 is never equal to 0!' };
434 Arguments: C<CodeRef $returning_message, Item $arg>
436 This is really just a special case of the L</log_$level> functions. It forces
437 scalar context when that is what you need. Other than that it works exactly
440 my $friend = logS_trace {
441 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
444 See also: L</DlogS_$level>.
450 Arguments: C<CodeRef $returning_message, @args>
452 All of the following six functions work the same as their L</log_$level>
453 brethren, except they return what is passed into them and put the stringified
454 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
455 you can do cool things like the following:
457 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
459 and the output might look something like:
469 my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
473 Dlog_debug { "random data structure: $_" } { foo => $bar };
477 return Dlog_info { "html from method returned: $_" } "<html>...</html>";
481 Dlog_warn { "probably invalid value: $_" } $foo;
485 Dlog_error { "non-numeric user input! ($_)" } $port;
489 Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
495 Arguments: C<CodeRef $returning_message, Item $arg>
497 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
498 They only take a single scalar after the C<$returning_message> instead of
499 slurping up (and also setting C<wantarray>) all the C<@args>
501 my $pals_rs = DlogS_debug { "pals resultset: $_" }
502 $schema->resultset('Pals')->search({ perlers => 1 });
504 =head1 LOGGER INTERFACE
506 Because this module is ultimately pretty looking glue (glittery?) with the
507 awesome benefit of the Contextual part, users will often want to make their
508 favorite logger work with it. The following are the methods that should be
509 implemented in the logger:
524 The first six merely need to return true if that level is enabled. The latter
525 six take the results of whatever the user returned from their coderef and log
526 them. For a basic example see L<Log::Contextual::SimpleLogger>.
530 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
534 mst - Matt S. Trout <mst@shadowcat.co.uk>
538 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
543 This library is free software and may be distributed under the same terms as