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
235 =head1 A WORK IN PROGRESS
237 This module is certainly not complete, but we will not break the interface
238 lightly, so I would say it's safe to use in production code. The main result
239 from that at this point is that doing:
243 will die as we do not yet know what the defaults should be. If it turns out
244 that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
245 probably make C<:log> the default. But only time and usage will tell.
247 =head1 IMPORT OPTIONS
249 See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
254 When you import this module you may use C<-logger> as a shortcut for
255 L<set_logger>, for example:
257 use Log::Contextual::SimpleLogger;
258 use Log::Contextual qw( :dlog ),
259 -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
261 sometimes you might want to have the logger handy for other stuff, in which
262 case you might try something like the following:
265 BEGIN { $var_log = VarLogger->new }
266 use Log::Contextual qw( :dlog ), -logger => $var_log;
270 The C<-levels> import option allows you to define exactly which levels your
271 logger supports. So the default,
272 C<< [qw(debug trace warn info error fatal)] >>, works great for
273 L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>. But
274 supporting those levels is as easy as doing
277 -levels => [qw( debug info notice warning error critical alert emergency )];
279 =head2 -package_logger
281 The C<-package_logger> import option is similar to the C<-logger> import option
282 except C<-package_logger> sets the the logger for the current package.
284 Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
288 use Log::Contextual::SimpleLogger;
289 use Log::Contextual qw( :log ),
290 -package_logger => Log::Contextual::WarnLogger->new({
291 env_prefix => 'MY_PACKAGE'
294 If you are interested in using this package for a module you are putting on
295 CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
297 =head2 -default_logger
299 The C<-default_logger> import option is similar to the C<-logger> import option
300 except C<-default_logger> sets the the B<default> logger for the current package.
302 Basically it sets the logger to be used if C<set_logger> is never called; so
305 use Log::Contextual::SimpleLogger;
306 use Log::Contextual qw( :log ),
307 -default_logger => Log::Contextual::WarnLogger->new({
308 env_prefix => 'MY_PACKAGE'
311 =head1 SETTING DEFAULT IMPORT OPTIONS
313 Eventually you will get tired of writing the following in every single one of
317 use Log::Log4perl ':easy';
318 BEGIN { Log::Log4perl->easy_init($DEBUG) }
320 use Log::Contextual -logger => Log::Log4perl->get_logger;
322 You can set any of the import options for your whole project if you define your
323 own C<Log::Contextual> subclass as follows:
325 package MyApp::Log::Contextual;
327 use base 'Log::Contextual';
329 use Log::Log4perl ':easy';
330 Log::Log4perl->easy_init($DEBUG)
332 sub arg_logger { $_[1] || Log::Log4perl->get_logger }
333 sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
335 # and *maybe* even these:
336 sub arg_package_logger { $_[1] }
337 sub arg_default_logger { $_[1] }
339 Note the C<< $_[1] || >> in C<arg_logger>. All of these methods are passed the
340 values passed in from the arguments to the subclass, so you can either throw
341 them away, honor them, die on usage, or whatever. To be clear, if you define
342 your subclass, and someone uses it as follows:
344 use MyApp::Log::Contextual -logger => $foo, -levels => [qw(bar baz biff)];
346 Your C<arg_logger> method will get C<$foo> and your C<arg_levels>
347 will get C<[qw(bar baz biff)]>;
353 my $logger = WarnLogger->new;
356 Arguments: C<Ref|CodeRef $returning_logger>
358 C<set_logger> will just set the current logger to whatever you pass it. It
359 expects a C<CodeRef>, but if you pass it something else it will wrap it in a
360 C<CodeRef> for you. C<set_logger> is really meant only to be called from a
361 top-level script. To avoid foot-shooting the function will warn if you call it
366 my $logger = WarnLogger->new;
367 with_logger $logger => sub {
369 log_fatal { 'Non Logical Universe Detected' };
371 log_info { 'All is good' };
375 Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
377 C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
378 As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
379 C<CodeRef> if needed.
385 Arguments: C<CodeRef $returning_message, @args>
387 All of the following six functions work the same except that a different method
388 is called on the underlying C<$logger> object. The basic pattern is:
390 sub log_$level (&@) {
391 if ($logger->is_$level) {
392 $logger->$level(shift->(@_));
397 Note that the function returns it's arguments. This can be used in a number of
398 ways, but often it's convenient just for partial inspection of passthrough data
400 my @friends = log_trace {
401 'friends list being generated, data from first friend: ' .
402 Dumper($_[0]->TO_JSON)
403 } generate_friend_list();
405 If you want complete inspection of passthrough data, take a look at the
406 L</Dlog_$level> functions.
410 log_trace { 'entered method foo with args ' join q{,}, @args };
414 log_debug { 'entered method foo' };
418 log_info { 'started process foo' };
422 log_warn { 'possible misconfiguration at line 10' };
426 log_error { 'non-numeric user input!' };
430 log_fatal { '1 is never equal to 0!' };
436 Arguments: C<CodeRef $returning_message, Item $arg>
438 This is really just a special case of the L</log_$level> functions. It forces
439 scalar context when that is what you need. Other than that it works exactly
442 my $friend = logS_trace {
443 'I only have one friend: ' . Dumper($_[0]->TO_JSON)
446 See also: L</DlogS_$level>.
452 Arguments: C<CodeRef $returning_message, @args>
454 All of the following six functions work the same as their L</log_$level>
455 brethren, except they return what is passed into them and put the stringified
456 (with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
457 you can do cool things like the following:
459 my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
461 and the output might look something like:
471 my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
475 Dlog_debug { "random data structure: $_" } { foo => $bar };
479 return Dlog_info { "html from method returned: $_" } "<html>...</html>";
483 Dlog_warn { "probably invalid value: $_" } $foo;
487 Dlog_error { "non-numeric user input! ($_)" } $port;
491 Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
497 Arguments: C<CodeRef $returning_message, Item $arg>
499 Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
500 They only take a single scalar after the C<$returning_message> instead of
501 slurping up (and also setting C<wantarray>) all the C<@args>
503 my $pals_rs = DlogS_debug { "pals resultset: $_" }
504 $schema->resultset('Pals')->search({ perlers => 1 });
506 =head1 LOGGER INTERFACE
508 Because this module is ultimately pretty looking glue (glittery?) with the
509 awesome benefit of the Contextual part, users will often want to make their
510 favorite logger work with it. The following are the methods that should be
511 implemented in the logger:
526 The first six merely need to return true if that level is enabled. The latter
527 six take the results of whatever the user returned from their coderef and log
528 them. For a basic example see L<Log::Contextual::SimpleLogger>.
532 frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com>
536 mst - Matt S. Trout <mst@shadowcat.co.uk>
540 Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
545 This library is free software and may be distributed under the same terms as