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.)
222 When you import this module you may use C<-logger> as a shortcut for
223 L<set_logger>, for example:
225 use Log::Contextual::SimpleLogger;
226 use Log::Contextual qw( :dlog ),
227 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
229 sometimes you might want to have the logger handy for other stuff, in which
230 case you might try something like the following:
233 BEGIN { $var_log = VarLogger->new }
234 use Log::Contextual qw( :dlog ), -logger => $var_log;
236 =head2 -package_logger
238 The C<-package_logger> import option is similar to the C<-logger> import option
239 except C<-package_logger> sets the the logger for the current package.
241 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
245 use Log::Contextual::SimpleLogger;
246 use Log::Contextual qw( :log ),
247 -package_logger => Log::Contextual::WarnLogger->new({
248 env_prefix => 'MY_PACKAGE'
251 If you are interested in using this package for a module you are putting on
252 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
254 =head2 -default_logger
256 The C<-default_logger> import option is similar to the C<-logger> import option
257 except C<-default_logger> sets the the B<default> logger for the current package.
259 Basically it sets the logger to be used if C<set_logger> is never called; so
262 use Log::Contextual::SimpleLogger;
263 use Log::Contextual qw( :log ),
264 -default_logger => Log::Contextual::WarnLogger->new({
265 env_prefix => 'MY_PACKAGE'
268 =head1 A WORK IN PROGRESS
270 This module is certainly not complete, but we will not break the interface
271 lightly, so I would say it's safe to use in production code. The main result
272 from that at this point is that doing:
276 will die as we do not yet know what the defaults should be. If it turns out
277 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
278 probably make C<:log> the default. But only time and usage will tell.
284 my $logger = WarnLogger->new;
287 Arguments: C<Ref|CodeRef $returning_logger>
289 C<set_logger> will just set the current logger to whatever you pass it. It
290 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
291 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
292 top-level script. To avoid foot-shooting the function will warn if you call it
297 my $logger = WarnLogger->new;
298 with_logger $logger => sub {
300 log_fatal { 'Non Logical Universe Detected' };
302 log_info { 'All is good' };
306 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
308 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
309 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
310 C<CodeRef> if needed.
316 Arguments: C<CodeRef $returning_message, @args>
318 All of the following six functions work the same except that a different method
319 is called on the underlying C<$logger> object. The basic pattern is:
321 sub log_$level (&@) {
322 if ($logger->is_$level) {
323 $logger->$level(shift->(@_));
328 Note that the function returns it's arguments. This can be used in a number of
329 ways, but often it's convenient just for partial inspection of passthrough data
331 my @friends = log_trace {
332 'friends list being generated, data from first friend: ' .
333 Dumper($_[0]->TO_JSON)
334 } generate_friend_list();
336 If you want complete inspection of passthrough data, take a look at the
337 L</Dlog_$level> functions.
341 log_trace { 'entered method foo with args ' join q{,}, @args };
345 log_debug { 'entered method foo' };
349 log_info { 'started process foo' };
353 log_warn { 'possible misconfiguration at line 10' };
357 log_error { 'non-numeric user input!' };
361 log_fatal { '1 is never equal to 0!' };
367 Arguments: C<CodeRef $returning_message, Item $arg>
369 This is really just a special case of the L</log_$level> functions. It forces
370 scalar context when that is what you need. Other than that it works exactly
373 my $friend = logS_trace {
374 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
377 See also: L</DlogS_$level>.
383 Arguments: C<CodeRef $returning_message, @args>
385 All of the following six functions work the same as their L</log_$level>
386 brethren, except they return what is passed into them and put the stringified
387 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
388 you can do cool things like the following:
390 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
392 and the output might look something like:
402 my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
406 Dlog_debug { "random data structure: $_" } { foo => $bar };
410 return Dlog_info { "html from method returned: $_" } "<html>...</html>";
414 Dlog_warn { "probably invalid value: $_" } $foo;
418 Dlog_error { "non-numeric user input! ($_)" } $port;
422 Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
428 Arguments: C<CodeRef $returning_message, Item $arg>
430 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
431 They only take a single scalar after the C<$returning_message> instead of
432 slurping up (and also setting C<wantarray>) all the C<@args>
434 my $pals_rs = DlogS_debug { "pals resultset: $_" }
435 $schema->resultset('Pals')->search({ perlers => 1 });
437 =head1 LOGGER INTERFACE
439 Because this module is ultimately pretty looking glue (glittery?) with the
440 awesome benefit of the Contextual part, users will often want to make their
441 favorite logger work with it. The following are the methods that should be
442 implemented in the logger:
457 The first six merely need to return true if that level is enabled. The latter
458 six take the results of whatever the user returned from their coderef and log
459 them. For a basic example see L<Log::Contextual::SimpleLogger>.
463 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
467 mst - Matt S. Trout <mst@shadowcat.co.uk>
471 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
476 This library is free software and may be distributed under the same terms as