1 package Log::Contextual;
6 our $VERSION = '0.00304';
8 my @levels = qw(debug trace warn info error fatal);
11 use Data::Dumper::Concise;
12 use Scalar::Util 'blessed';
14 BEGIN { our @ISA = qw(Exporter) }
16 my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
18 my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
21 require Log::Log4perl;
22 die if $Log::Log4perl::VERSION < 1.29;
23 Log::Log4perl->wrapper_register(__PACKAGE__)
28 qw( set_logger with_logger )
39 die 'Log::Contextual does not have a default import list'
42 for my $idx ( 0 .. $#_ ) {
44 if ( defined $val && $val eq '-logger' ) {
45 set_logger($_[$idx + 1]);
47 } elsif ( defined $val && $val eq '-package_logger' ) {
48 _set_package_logger_for(scalar caller, $_[$idx + 1]);
50 } elsif ( defined $val && $val eq '-default_logger' ) {
51 _set_default_logger_for(scalar caller, $_[$idx + 1]);
55 $package->export_to_level(1, $package, @_);
62 sub _set_default_logger_for {
64 if(ref $logger ne 'CODE') {
65 die 'logger was not a CodeRef or a logger object. Please try again.'
66 unless blessed($logger);
67 $logger = do { my $l = $logger; sub { $l } }
69 $Default_Logger{$_[0]} = $logger
72 sub _set_package_logger_for {
74 if(ref $logger ne 'CODE') {
75 die 'logger was not a CodeRef or a logger object. Please try again.'
76 unless blessed($logger);
77 $logger = do { my $l = $logger; sub { $l } }
79 $Package_Logger{$_[0]} = $logger
85 $Package_Logger{$package} ||
87 $Default_Logger{$package} ||
88 die q( no logger set! you can't try to log something without a logger! )
94 if(ref $logger ne 'CODE') {
95 die 'logger was not a CodeRef or a logger object. Please try again.'
96 unless blessed($logger);
97 $logger = do { my $l = $logger; sub { $l } }
100 warn 'set_logger (or -logger) called more than once! This is a bad idea!'
102 $Get_Logger = $logger;
107 if(ref $logger ne 'CODE') {
108 die 'logger was not a CodeRef or a logger object. Please try again.'
109 unless blessed($logger);
110 $logger = do { my $l = $logger; sub { $l } }
112 local $Get_Logger = $logger;
122 $logger->$level($code->(@_))
123 if $logger->${\"is_$level"};
133 $logger->$level($code->($value))
134 if $logger->${\"is_$level"};
138 for my $level (@levels) {
141 *{"log_$level"} = sub (&@) {
142 _do_log( $level => _get_logger( caller ), shift @_, @_)
145 *{"logS_$level"} = sub (&$) {
146 _do_logS( $level => _get_logger( caller ), $_[0], $_[1])
149 *{"Dlog_$level"} = sub (&@) {
151 local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
152 return _do_log( $level => _get_logger( caller ), $code, @_ );
155 *{"DlogS_$level"} = sub (&$) {
156 local $_ = Data::Dumper::Concise::Dumper $_[1];
157 _do_logS( $level => _get_logger( caller ), $_[0], $_[1] )
167 Log::Contextual - Simple logging interface with a contextual log
171 use Log::Contextual qw( :log :dlog set_logger with_logger );
172 use Log::Contextual::SimpleLogger;
173 use Log::Log4perl ':easy';
174 Log::Log4perl->easy_init($DEBUG);
177 my $logger = Log::Log4perl->get_logger;
181 log_debug { 'program started' };
184 with_logger(Log::Contextual::SimpleLogger->new({
185 levels => [qw( trace debug )]
187 log_trace { 'foo entered' };
188 my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
190 log_trace { 'foo left' };
196 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
197 with C<Log::Contextual>:
199 use Log::Contextual qw( :log :dlog set_logger );
200 use Log::Dispatchouli;
201 my $ld = Log::Dispatchouli->new({
202 ident => 'slrtbrfst',
209 log_debug { 'program started' };
213 This module is a simple interface to extensible logging. It is bundled with a
214 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
215 should use a real logger instead of that. For something more serious but not
216 overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
218 The reason for this module is to abstract your logging interface so that
219 logging is as painless as possible, while still allowing you to switch from one
226 When you import this module you may use C<-logger> as a shortcut for
227 L<set_logger>, for example:
229 use Log::Contextual::SimpleLogger;
230 use Log::Contextual qw( :dlog ),
231 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
233 sometimes you might want to have the logger handy for other stuff, in which
234 case you might try something like the following:
237 BEGIN { $var_log = VarLogger->new }
238 use Log::Contextual qw( :dlog ), -logger => $var_log;
240 =head2 -package_logger
242 The C<-package_logger> import option is similar to the C<-logger> import option
243 except C<-package_logger> sets the the logger for the current package.
245 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
249 use Log::Contextual::SimpleLogger;
250 use Log::Contextual qw( :log ),
251 -package_logger => Log::Contextual::WarnLogger->new({
252 env_prefix => 'MY_PACKAGE'
255 If you are interested in using this package for a module you are putting on
256 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
258 =head2 -default_logger
260 The C<-default_logger> import option is similar to the C<-logger> import option
261 except C<-default_logger> sets the the B<default> logger for the current package.
263 Basically it sets the logger to be used if C<set_logger> is never called; so
266 use Log::Contextual::SimpleLogger;
267 use Log::Contextual qw( :log ),
268 -default_logger => Log::Contextual::WarnLogger->new({
269 env_prefix => 'MY_PACKAGE'
272 =head1 A WORK IN PROGRESS
274 This module is certainly not complete, but we will not break the interface
275 lightly, so I would say it's safe to use in production code. The main result
276 from that at this point is that doing:
280 will die as we do not yet know what the defaults should be. If it turns out
281 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
282 probably make C<:log> the default. But only time and usage will tell.
288 my $logger = WarnLogger->new;
291 Arguments: C<Ref|CodeRef $returning_logger>
293 C<set_logger> will just set the current logger to whatever you pass it. It
294 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
295 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
296 top-level script. To avoid foot-shooting the function will warn if you call it
301 my $logger = WarnLogger->new;
302 with_logger $logger => sub {
304 log_fatal { 'Non Logical Universe Detected' };
306 log_info { 'All is good' };
310 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
312 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
313 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
314 C<CodeRef> if needed.
320 Arguments: C<CodeRef $returning_message, @args>
322 All of the following six functions work the same except that a different method
323 is called on the underlying C<$logger> object. The basic pattern is:
325 sub log_$level (&@) {
326 if ($logger->is_$level) {
327 $logger->$level(shift->(@_));
332 Note that the function returns it's arguments. This can be used in a number of
333 ways, but often it's convenient just for partial inspection of passthrough data
335 my @friends = log_trace {
336 'friends list being generated, data from first friend: ' .
337 Dumper($_[0]->TO_JSON)
338 } generate_friend_list();
340 If you want complete inspection of passthrough data, take a look at the
341 L</Dlog_$level> functions.
345 log_trace { 'entered method foo with args ' join q{,}, @args };
349 log_debug { 'entered method foo' };
353 log_info { 'started process foo' };
357 log_warn { 'possible misconfiguration at line 10' };
361 log_error { 'non-numeric user input!' };
365 log_fatal { '1 is never equal to 0!' };
371 Arguments: C<CodeRef $returning_message, Item $arg>
373 This is really just a special case of the L</log_$level> functions. It forces
374 scalar context when that is what you need. Other than that it works exactly
377 my $friend = logS_trace {
378 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
381 See also: L</DlogS_$level>.
387 Arguments: C<CodeRef $returning_message, @args>
389 All of the following six functions work the same as their L</log_$level>
390 brethren, except they return what is passed into them and put the stringified
391 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
392 you can do cool things like the following:
394 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
396 and the output might look something like:
406 my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
410 Dlog_debug { "random data structure: $_" } { foo => $bar };
414 return Dlog_info { "html from method returned: $_" } "<html>...</html>";
418 Dlog_warn { "probably invalid value: $_" } $foo;
422 Dlog_error { "non-numeric user input! ($_)" } $port;
426 Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
432 Arguments: C<CodeRef $returning_message, Item $arg>
434 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
435 They only take a single scalar after the C<$returning_message> instead of
436 slurping up (and also setting C<wantarray>) all the C<@args>
438 my $pals_rs = DlogS_debug { "pals resultset: $_" }
439 $schema->resultset('Pals')->search({ perlers => 1 });
441 =head1 LOGGER INTERFACE
443 Because this module is ultimately pretty looking glue (glittery?) with the
444 awesome benefit of the Contextual part, users will often want to make their
445 favorite logger work with it. The following are the methods that should be
446 implemented in the logger:
461 The first six merely need to return true if that level is enabled. The latter
462 six take the results of whatever the user returned from their coderef and log
463 them. For a basic example see L<Log::Contextual::SimpleLogger>.
467 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
471 mst - Matt S. Trout <mst@shadowcat.co.uk>
475 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
480 This library is free software and may be distributed under the same terms as