1 package Log::Contextual;
6 our $VERSION = '0.00305';
8 my @levels = qw(debug trace warn info error fatal);
10 use Exporter::Declare;
11 use Exporter::Declare::Export::Generator;
12 use Data::Dumper::Concise;
13 use Scalar::Util 'blessed';
15 my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
17 my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
20 require Log::Log4perl;
21 die if $Log::Log4perl::VERSION < 1.29;
22 Log::Log4perl->wrapper_register(__PACKAGE__)
25 # ____ is because tags must have at least one export and we don't want to
26 # export anything but the levels selected
31 qw( set_logger with_logger )
34 export_tag dlog => ('____');
35 export_tag log => ('____');
36 import_arguments qw(logger package_logger default_logger);
39 my ($class, $importer, $spec) = @_;
41 die 'Log::Contextual does not have a default import list'
42 if $spec->config->{default};
44 my @levels = @{$class->arg_levels($spec->config->{levels})};
45 for my $level (@levels) {
46 if ($spec->config->{log}) {
47 $spec->add_export("&log_$level", sub (&@) {
48 _do_log( $level => _get_logger( caller ), shift @_, @_)
50 $spec->add_export("&logS_$level", sub (&@) {
51 _do_logS( $level => _get_logger( caller ), $_[0], $_[1])
54 if ($spec->config->{dlog}) {
55 $spec->add_export("&Dlog_$level", sub (&@) {
56 my ($code, @args) = @_;
57 return _do_log( $level => _get_logger( caller ), sub {
58 local $_ = (@args?Data::Dumper::Concise::Dumper @args:'()');
62 $spec->add_export("&DlogS_$level", sub (&$) {
63 my ($code, $ref) = @_;
64 _do_logS( $level => _get_logger( caller ), sub {
65 local $_ = Data::Dumper::Concise::Dumper $ref;
73 sub arg_logger { $_[1] }
74 sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
75 sub arg_package_logger { $_[1] }
76 sub arg_default_logger { $_[1] }
79 my ($class, $importer, $specs) = @_;
81 if (my $l = $class->arg_logger($specs->config->{logger})) {
85 if (my $l = $class->arg_package_logger($specs->config->{package_logger})) {
86 _set_package_logger_for($importer, $l)
89 if (my $l = $class->arg_default_logger($specs->config->{default_logger})) {
90 _set_default_logger_for($importer, $l)
98 sub _set_default_logger_for {
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 } }
105 $Default_Logger{$_[0]} = $logger
108 sub _set_package_logger_for {
110 if(ref $logger ne 'CODE') {
111 die 'logger was not a CodeRef or a logger object. Please try again.'
112 unless blessed($logger);
113 $logger = do { my $l = $logger; sub { $l } }
115 $Package_Logger{$_[0]} = $logger
121 $Package_Logger{$package} ||
123 $Default_Logger{$package} ||
124 die q( no logger set! you can't try to log something without a logger! )
130 if(ref $logger ne 'CODE') {
131 die 'logger was not a CodeRef or a logger object. Please try again.'
132 unless blessed($logger);
133 $logger = do { my $l = $logger; sub { $l } }
136 warn 'set_logger (or -logger) called more than once! This is a bad idea!'
138 $Get_Logger = $logger;
143 if(ref $logger ne 'CODE') {
144 die 'logger was not a CodeRef or a logger object. Please try again.'
145 unless blessed($logger);
146 $logger = do { my $l = $logger; sub { $l } }
148 local $Get_Logger = $logger;
158 $logger->$level($code->(@_))
159 if $logger->${\"is_$level"};
169 $logger->$level($code->($value))
170 if $logger->${\"is_$level"};
180 Log::Contextual - Simple logging interface with a contextual log
184 use Log::Contextual qw( :log :dlog set_logger with_logger );
185 use Log::Contextual::SimpleLogger;
186 use Log::Log4perl ':easy';
187 Log::Log4perl->easy_init($DEBUG);
190 my $logger = Log::Log4perl->get_logger;
194 log_debug { 'program started' };
197 with_logger(Log::Contextual::SimpleLogger->new({
198 levels => [qw( trace debug )]
200 log_trace { 'foo entered' };
201 my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
203 log_trace { 'foo left' };
209 Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
210 with C<Log::Contextual>:
212 use Log::Contextual qw( :log :dlog set_logger );
213 use Log::Dispatchouli;
214 my $ld = Log::Dispatchouli->new({
215 ident => 'slrtbrfst',
222 log_debug { 'program started' };
226 This module is a simple interface to extensible logging. It is bundled with a
227 really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
228 should use a real logger instead of that. For something more serious but not
229 overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
231 The reason for this module is to abstract your logging interface so that
232 logging is as painless as possible, while still allowing you to switch from one
239 When you import this module you may use C<-logger> as a shortcut for
240 L<set_logger>, for example:
242 use Log::Contextual::SimpleLogger;
243 use Log::Contextual qw( :dlog ),
244 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
246 sometimes you might want to have the logger handy for other stuff, in which
247 case you might try something like the following:
250 BEGIN { $var_log = VarLogger->new }
251 use Log::Contextual qw( :dlog ), -logger => $var_log;
255 The C<-levels> import option allows you to define exactly which levels your
256 logger supports. So the default,
257 C<< [qw(debug trace warn info error fatal)] >>, works great for
258 L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>. But
259 supporting those levels is as easy as doing
262 -levels => [qw( debug info notice warning error critical alert emergency )];
264 =head2 -package_logger
266 The C<-package_logger> import option is similar to the C<-logger> import option
267 except C<-package_logger> sets the the logger for the current package.
269 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
273 use Log::Contextual::SimpleLogger;
274 use Log::Contextual qw( :log ),
275 -package_logger => Log::Contextual::WarnLogger->new({
276 env_prefix => 'MY_PACKAGE'
279 If you are interested in using this package for a module you are putting on
280 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
282 =head2 -default_logger
284 The C<-default_logger> import option is similar to the C<-logger> import option
285 except C<-default_logger> sets the the B<default> logger for the current package.
287 Basically it sets the logger to be used if C<set_logger> is never called; so
290 use Log::Contextual::SimpleLogger;
291 use Log::Contextual qw( :log ),
292 -default_logger => Log::Contextual::WarnLogger->new({
293 env_prefix => 'MY_PACKAGE'
296 =head1 A WORK IN PROGRESS
298 This module is certainly not complete, but we will not break the interface
299 lightly, so I would say it's safe to use in production code. The main result
300 from that at this point is that doing:
304 will die as we do not yet know what the defaults should be. If it turns out
305 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
306 probably make C<:log> the default. But only time and usage will tell.
312 my $logger = WarnLogger->new;
315 Arguments: C<Ref|CodeRef $returning_logger>
317 C<set_logger> will just set the current logger to whatever you pass it. It
318 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
319 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
320 top-level script. To avoid foot-shooting the function will warn if you call it
325 my $logger = WarnLogger->new;
326 with_logger $logger => sub {
328 log_fatal { 'Non Logical Universe Detected' };
330 log_info { 'All is good' };
334 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
336 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
337 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
338 C<CodeRef> if needed.
344 Arguments: C<CodeRef $returning_message, @args>
346 All of the following six functions work the same except that a different method
347 is called on the underlying C<$logger> object. The basic pattern is:
349 sub log_$level (&@) {
350 if ($logger->is_$level) {
351 $logger->$level(shift->(@_));
356 Note that the function returns it's arguments. This can be used in a number of
357 ways, but often it's convenient just for partial inspection of passthrough data
359 my @friends = log_trace {
360 'friends list being generated, data from first friend: ' .
361 Dumper($_[0]->TO_JSON)
362 } generate_friend_list();
364 If you want complete inspection of passthrough data, take a look at the
365 L</Dlog_$level> functions.
369 log_trace { 'entered method foo with args ' join q{,}, @args };
373 log_debug { 'entered method foo' };
377 log_info { 'started process foo' };
381 log_warn { 'possible misconfiguration at line 10' };
385 log_error { 'non-numeric user input!' };
389 log_fatal { '1 is never equal to 0!' };
395 Arguments: C<CodeRef $returning_message, Item $arg>
397 This is really just a special case of the L</log_$level> functions. It forces
398 scalar context when that is what you need. Other than that it works exactly
401 my $friend = logS_trace {
402 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
405 See also: L</DlogS_$level>.
411 Arguments: C<CodeRef $returning_message, @args>
413 All of the following six functions work the same as their L</log_$level>
414 brethren, except they return what is passed into them and put the stringified
415 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
416 you can do cool things like the following:
418 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
420 and the output might look something like:
430 my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
434 Dlog_debug { "random data structure: $_" } { foo => $bar };
438 return Dlog_info { "html from method returned: $_" } "<html>...</html>";
442 Dlog_warn { "probably invalid value: $_" } $foo;
446 Dlog_error { "non-numeric user input! ($_)" } $port;
450 Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
456 Arguments: C<CodeRef $returning_message, Item $arg>
458 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
459 They only take a single scalar after the C<$returning_message> instead of
460 slurping up (and also setting C<wantarray>) all the C<@args>
462 my $pals_rs = DlogS_debug { "pals resultset: $_" }
463 $schema->resultset('Pals')->search({ perlers => 1 });
465 =head1 LOGGER INTERFACE
467 Because this module is ultimately pretty looking glue (glittery?) with the
468 awesome benefit of the Contextual part, users will often want to make their
469 favorite logger work with it. The following are the methods that should be
470 implemented in the logger:
485 The first six merely need to return true if that level is enabled. The latter
486 six take the results of whatever the user returned from their coderef and log
487 them. For a basic example see L<Log::Contextual::SimpleLogger>.
491 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
495 mst - Matt S. Trout <mst@shadowcat.co.uk>
499 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
504 This library is free software and may be distributed under the same terms as