File Coverage

blib/lib/Log/Dispatchouli.pm
Criterion Covered Total %
statement 136 168 80.9
branch 45 86 52.3
condition 12 20 60.0
subroutine 41 59 69.4
pod 32 37 86.4
total 266 370 71.8


line stmt bran cond sub pod time code
1 6     6   102593 use strict;
  6         36  
  6         177  
2 6     6   32 use warnings;
  6         12  
  6         302  
3             package Log::Dispatchouli;
4             # ABSTRACT: a simple wrapper around Log::Dispatch
5             $Log::Dispatchouli::VERSION = '2.022';
6 6     6   39 use Carp ();
  6         9  
  6         107  
7 6     6   30 use File::Spec ();
  6         10  
  6         109  
8 6     6   3107 use Log::Dispatch;
  6         1488584  
  6         231  
9 6     6   3091 use Params::Util qw(_ARRAY0 _HASH0 _CODELIKE);
  6         16424  
  6         451  
10 6     6   46 use Scalar::Util qw(blessed weaken);
  6         13  
  6         263  
11 6     6   2742 use String::Flogger;
  6         64234  
  6         41  
12 6     6   1193 use Try::Tiny 0.04;
  6         136  
  6         6338  
13              
14             require Log::Dispatchouli::Proxy;
15              
16             our @CARP_NOT = qw(Log::Dispatchouli::Proxy);
17              
18             #pod =head1 SYNOPSIS
19             #pod
20             #pod my $logger = Log::Dispatchouli->new({
21             #pod ident => 'stuff-purger',
22             #pod facility => 'daemon',
23             #pod to_stdout => $opt->{print},
24             #pod debug => $opt->{verbose}
25             #pod });
26             #pod
27             #pod $logger->log([ "There are %s items left to purge...", $stuff_left ]);
28             #pod
29             #pod $logger->log_debug("this is extra often-ignored debugging log");
30             #pod
31             #pod $logger->log_fatal("Now we will die!!");
32             #pod
33             #pod =head1 DESCRIPTION
34             #pod
35             #pod Log::Dispatchouli is a thin layer above L<Log::Dispatch> and meant to make it
36             #pod dead simple to add logging to a program without having to think much about
37             #pod categories, facilities, levels, or things like that. It is meant to make
38             #pod logging just configurable enough that you can find the logs you want and just
39             #pod easy enough that you will actually log things.
40             #pod
41             #pod Log::Dispatchouli can log to syslog (if you specify a facility), standard error
42             #pod or standard output, to a file, or to an array in memory. That last one is
43             #pod mostly useful for testing.
44             #pod
45             #pod In addition to providing as simple a way to get a handle for logging
46             #pod operations, Log::Dispatchouli uses L<String::Flogger> to process the things to
47             #pod be logged, meaning you can easily log data structures. Basically: strings are
48             #pod logged as is, arrayrefs are taken as (sprintf format, args), and subroutines
49             #pod are called only if needed. For more information read the L<String::Flogger>
50             #pod docs.
51             #pod
52             #pod =head1 LOGGER PREFIX
53             #pod
54             #pod Log messages may be prepended with information to set context. This can be set
55             #pod at a logger level or per log item. The simplest example is:
56             #pod
57             #pod my $logger = Log::Dispatchouli->new( ... );
58             #pod
59             #pod $logger->set_prefix("Batch 123: ");
60             #pod
61             #pod $logger->log("begun processing");
62             #pod
63             #pod # ...
64             #pod
65             #pod $logger->log("finished processing");
66             #pod
67             #pod The above will log something like:
68             #pod
69             #pod Batch 123: begun processing
70             #pod Batch 123: finished processing
71             #pod
72             #pod To pass a prefix per-message:
73             #pod
74             #pod $logger->log({ prefix => 'Sub-Item 234: ' }, 'error!')
75             #pod
76             #pod # Logs: Batch 123: Sub-Item 234: error!
77             #pod
78             #pod If the prefix is a string, it is prepended to each line of the message. If it
79             #pod is a coderef, it is called and passed the message to be logged. The return
80             #pod value is logged instead.
81             #pod
82             #pod L<Proxy loggers|/METHODS FOR PROXY LOGGERS> also have their own prefix
83             #pod settings, which accumulate. So:
84             #pod
85             #pod my $proxy = $logger->proxy({ proxy_prefix => 'Subsystem 12: ' });
86             #pod
87             #pod $proxy->set_prefix('Page 9: ');
88             #pod
89             #pod $proxy->log({ prefix => 'Paragraph 6: ' }, 'Done.');
90             #pod
91             #pod ...will log...
92             #pod
93             #pod Batch 123: Subsystem 12: Page 9: Paragraph 6: Done.
94             #pod
95             #pod =method new
96             #pod
97             #pod my $logger = Log::Dispatchouli->new(\%arg);
98             #pod
99             #pod This returns a new logger, a Log::Dispatchouli object.
100             #pod
101             #pod Valid arguments are:
102             #pod
103             #pod ident - the name of the thing logging (mandatory)
104             #pod to_self - log to the logger object for testing; default: false
105             #pod to_stdout - log to STDOUT; default: false
106             #pod to_stderr - log to STDERR; default: false
107             #pod facility - to which syslog facility to send logs; default: none
108             #pod
109             #pod to_file - log to PROGRAM_NAME.YYYYMMDD in the log path; default: false
110             #pod log_file - a leaf name for the file to log to with to_file
111             #pod log_path - path in which to log to file; defaults to DISPATCHOULI_PATH
112             #pod environment variable or, failing that, to your system's tmpdir
113             #pod
114             #pod file_format - this optional coderef is passed the message to be logged
115             #pod and returns the text to write out
116             #pod
117             #pod log_pid - if true, prefix all log entries with the pid; default: true
118             #pod fail_fatal - a boolean; if true, failure to log is fatal; default: true
119             #pod muted - a boolean; if true, only fatals are logged; default: false
120             #pod debug - a boolean; if true, log_debug method is not a no-op
121             #pod defaults to the truth of the DISPATCHOULI_DEBUG env var
122             #pod quiet_fatal - 'stderr' or 'stdout' or an arrayref of zero, one, or both
123             #pod fatal log messages will not be logged to these
124             #pod (default: stderr)
125             #pod config_id - a name for this logger's config; rarely needed!
126             #pod syslog_socket - a value for Sys::Syslog's "socket" arg; default: "native"
127             #pod
128             #pod The log path is either F</tmp> or the value of the F<DISPATCHOULI_PATH> env var.
129             #pod
130             #pod If the F<DISPATCHOULI_NOSYSLOG> env var is true, we don't log to syslog.
131             #pod
132             #pod =cut
133              
134             sub new {
135 20     20 1 7425 my ($class, $arg) = @_;
136              
137             my $ident = $arg->{ident}
138 20 100       264 or Carp::croak "no ident specified when using $class";
139              
140 19 50       61 my $config_id = defined $arg->{config_id} ? $arg->{config_id} : $ident;
141              
142 19         37 my %quiet_fatal;
143 19         47 for ('quiet_fatal') {
144 19         83 %quiet_fatal = map {; $_ => 1 } grep { defined }
  19         62  
145             exists $arg->{$_}
146 19 0       66 ? _ARRAY0($arg->{$_}) ? @{ $arg->{$_} } : $arg->{$_}
  0 50       0  
147             : ('stderr');
148             };
149              
150 19         98 my $log = Log::Dispatch->new;
151             my $self = bless {
152             dispatcher => $log,
153 19 100       1090 log_pid => (exists $arg->{log_pid} ? $arg->{log_pid} : 1),
154             } => $class;
155              
156 19 100       63 if ($arg->{to_file}) {
157 2         463 require Log::Dispatch::File;
158             my $log_file = File::Spec->catfile(
159             ($arg->{log_path} || $self->env_value('PATH') || File::Spec->tmpdir),
160 2   33     68631 $arg->{log_file} || do {
      66        
161             my @time = localtime;
162             sprintf('%s.%04u%02u%02u',
163             $ident,
164             $time[5] + 1900,
165             $time[4] + 1,
166             $time[3])
167             }
168             );
169              
170             $log->add(
171             Log::Dispatch::File->new(
172             name => 'logfile',
173             min_level => 'debug',
174             filename => $log_file,
175             mode => 'append',
176 2         8 callbacks => do {
177 2 100       7 if (my $format = $arg->{file_format}) {
178             sub {
179 1     1   94 my $message = {@_}->{message};
180 1 50       6 $message = "[$$] $message" if $self->{log_pid};
181 1         3 $format->($message)
182 1         9 };
183             } else {
184             # The time format returned here is subject to change. -- rjbs,
185             # 2008-11-21
186             sub {
187 1     1   178 my $message = {@_}->{message};
188 1 50       9 $message = "[$$] $message" if $self->{log_pid};
189 1         33 (localtime) . " $message\n";
190 1         13 };
191             }
192             },
193             )
194             );
195             }
196              
197 19 50 33     868 if ($arg->{facility} and not $self->env_value('NOSYSLOG')) {
198             $self->setup_syslog_output(
199             facility => $arg->{facility},
200             socket => $arg->{syslog_socket},
201 0         0 ident => $ident,
202             );
203             }
204              
205 19 100       54 if ($arg->{to_self}) {
206 16         176 $self->{events} = [];
207 16         2280 require Log::Dispatch::Array;
208             $log->add(
209             Log::Dispatch::Array->new(
210             name => 'self',
211             min_level => 'debug',
212             array => $self->{events},
213 2     2   276 ($self->{log_pid} ? (callbacks => sub { "[$$] ". {@_}->{message} })
214 16 100       176675 : ())
215             ),
216             );
217             }
218              
219 19         2256 $self->{prefix} = $arg->{prefix};
220 19         46 $self->{ident} = $ident;
221 19         43 $self->{config_id} = $config_id;
222              
223 19         41 DEST: for my $dest (qw(err out)) {
224 38 50       149 next DEST unless $arg->{"to_std$dest"};
225 0         0 my $method = "enable_std$dest";
226              
227 0         0 $self->$method;
228             }
229              
230             $self->{debug} = exists $arg->{debug}
231 19 50       133 ? ($arg->{debug} ? 1 : 0)
    100          
    100          
232             : ($self->env_value('DEBUG') ? 1 : 0);
233 19         61 $self->{muted} = $arg->{muted};
234              
235 19         47 $self->{quiet_fatal} = \%quiet_fatal;
236 19 50       66 $self->{fail_fatal} = exists $arg->{fail_fatal} ? $arg->{fail_fatal} : 1;
237              
238 19         87 return $self;
239             }
240              
241             for my $dest (qw(out err)) {
242             my $name = "std$dest";
243             my $code = sub {
244 0 0   0   0 return if $_[0]->dispatcher->output($name);
245              
246 0     0   0 my $callback = $_[0]->{log_pid} ? sub { "[$$] " . ({@_}->{message}) . "\n" }
247 0 0   0   0 : sub { ({@_}->{message}) . "\n" };
  0         0  
248              
249             $_[0]->dispatcher->add(
250             $_[0]->stdio_dispatcher_class->new(
251             name => "std$dest",
252             min_level => 'debug',
253             stderr => ($dest eq 'err' ? 1 : 0),
254             callbacks => $callback,
255 0 0       0 ($_[0]{quiet_fatal}{"std$dest"} ? (max_level => 'info') : ()),
    0          
256             ),
257             );
258             };
259              
260 6     6   54 no strict 'refs';
  6         14  
  6         10745  
261             *{"enable_std$dest"} = $code;
262             }
263              
264             sub setup_syslog_output {
265 0     0 0 0 my ($self, %arg) = @_;
266              
267 0         0 require Log::Dispatch::Syslog;
268             $self->{dispatcher}->add(
269             Log::Dispatch::Syslog->new(
270             name => 'syslog',
271             min_level => 'debug',
272             facility => $arg{facility},
273             ident => $arg{ident},
274             logopt => ($self->{log_pid} ? 'pid' : ''),
275             socket => $arg{socket} || 'native',
276             callbacks => sub {
277 0     0   0 ( my $m = {@_}->{message} ) =~ s/\n/<LF>/g;
278 0         0 $m
279             },
280 0 0 0     0 ),
281             );
282             }
283              
284             #pod =method log
285             #pod
286             #pod $logger->log(@messages);
287             #pod
288             #pod $logger->log(\%arg, @messages);
289             #pod
290             #pod This method uses L<String::Flogger> on the input, then I<unconditionally> logs
291             #pod the result. Each message is flogged individually, then joined with spaces.
292             #pod
293             #pod If the first argument is a hashref, it will be used as extra arguments to
294             #pod logging. It may include a C<prefix> entry to preprocess the message by
295             #pod prepending a string (if the prefix is a string) or calling a subroutine to
296             #pod generate a new message (if the prefix is a coderef).
297             #pod
298             #pod =cut
299              
300 1     1   3 sub _join { shift; join q{ }, @{ $_[0] } }
  1         3  
  1         5  
301              
302             sub log {
303 41     41 1 3443 my ($self, @rest) = @_;
304 41 100       152 my $arg = _HASH0($rest[0]) ? shift(@rest) : {};
305              
306 41         70 my $message;
307              
308 41 100 100     144 if ($arg->{fatal} or ! $self->get_muted) {
309             try {
310 39     39   1729 my $flogger = $self->string_flogger;
311 39         73 my @flogged = map {; $flogger->flog($_) } @rest;
  40         224  
312 39 100       828 $message = @flogged > 1 ? $self->_join(\@flogged) : $flogged[0];
313              
314             my $prefix = _ARRAY0($arg->{prefix})
315 15         38 ? [ @{ $arg->{prefix} } ]
316 39 100       167 : [ $arg->{prefix} ];
317              
318 39         109 for (reverse grep { defined } $self->get_prefix, @$prefix) {
  116         251  
319 54 100       111 if (_CODELIKE( $_ )) {
320 1         3 $message = $_->($message);
321             } else {
322 53         209 $message =~ s/^/$_/gm;
323             }
324             }
325              
326             $self->dispatcher->log(
327 39   100     113 level => $arg->{level} || 'info',
328             message => $message,
329             );
330             } catch {
331 0 0   0   0 $message = '(no message could be logged)' unless defined $message;
332 0 0       0 die $_ if $self->{fail_fatal};
333 39         316 };
334             }
335              
336 41 100       4820 Carp::croak $message if $arg->{fatal};
337              
338 38         128 return;
339             }
340              
341             #pod =method log_fatal
342             #pod
343             #pod This behaves like the C<log> method, but will throw the logged string as an
344             #pod exception after logging.
345             #pod
346             #pod This method can also be called as C<fatal>, to match other popular logging
347             #pod interfaces. B<If you want to override this method, you must override
348             #pod C<log_fatal> and not C<fatal>>.
349             #pod
350             #pod =cut
351              
352             sub log_fatal {
353 3     3 1 21971 my ($self, @rest) = @_;
354              
355 3 50       20 my $arg = _HASH0($rest[0]) ? shift(@rest) : {}; # for future expansion
356              
357 3 50       14 local $arg->{level} = defined $arg->{level} ? $arg->{level} : 'error';
358 3 50       13 local $arg->{fatal} = defined $arg->{fatal} ? $arg->{fatal} : 1;
359              
360 3         11 $self->log($arg, @rest);
361             }
362              
363             #pod =method log_debug
364             #pod
365             #pod This behaves like the C<log> method, but will only log (at the debug level) if
366             #pod the logger object has its debug property set to true.
367             #pod
368             #pod This method can also be called as C<debug>, to match other popular logging
369             #pod interfaces. B<If you want to override this method, you must override
370             #pod C<log_debug> and not C<debug>>.
371             #pod
372             #pod =cut
373              
374             sub log_debug {
375 5     5 1 584 my ($self, @rest) = @_;
376              
377 5 50       17 return unless $self->is_debug;
378              
379 0 0       0 my $arg = _HASH0($rest[0]) ? shift(@rest) : {}; # for future expansion
380              
381 0 0       0 local $arg->{level} = defined $arg->{level} ? $arg->{level} : 'debug';
382              
383 0         0 $self->log($arg, @rest);
384             }
385              
386             #pod =method set_debug
387             #pod
388             #pod $logger->set_debug($bool);
389             #pod
390             #pod This sets the logger's debug property, which affects the behavior of
391             #pod C<log_debug>.
392             #pod
393             #pod =cut
394              
395             sub set_debug {
396 0 0   0 1 0 return($_[0]->{debug} = $_[1] ? 1 : 0);
397             }
398              
399             #pod =method get_debug
400             #pod
401             #pod This gets the logger's debug property, which affects the behavior of
402             #pod C<log_debug>.
403             #pod
404             #pod =cut
405              
406 13     13 1 53 sub get_debug { return $_[0]->{debug} }
407              
408             #pod =method clear_debug
409             #pod
410             #pod This method does nothing, and is only useful for L<Log::Dispatchouli::Proxy>
411             #pod objects. See L<Methods for Proxy Loggers|/METHODS FOR PROXY LOGGERS>, below.
412             #pod
413             #pod =cut
414              
415       0 1   sub clear_debug { }
416              
417 1     1 0 8 sub mute { $_[0]{muted} = 1 }
418 3     3 0 17 sub unmute { $_[0]{muted} = 0 }
419              
420             #pod =method set_muted
421             #pod
422             #pod $logger->set_muted($bool);
423             #pod
424             #pod This sets the logger's muted property, which affects the behavior of
425             #pod C<log>.
426             #pod
427             #pod =cut
428              
429             sub set_muted {
430 0 0   0 1 0 return($_[0]->{muted} = $_[1] ? 1 : 0);
431             }
432              
433             #pod =method get_muted
434             #pod
435             #pod This gets the logger's muted property, which affects the behavior of
436             #pod C<log>.
437             #pod
438             #pod =cut
439              
440 38     38 1 181 sub get_muted { return $_[0]->{muted} }
441              
442             #pod =method clear_muted
443             #pod
444             #pod This method does nothing, and is only useful for L<Log::Dispatchouli::Proxy>
445             #pod objects. See L<Methods for Proxy Loggers|/METHODS FOR PROXY LOGGERS>, below.
446             #pod
447             #pod =cut
448              
449       0 1   sub clear_muted { }
450              
451             #pod =method get_prefix
452             #pod
453             #pod my $prefix = $logger->get_prefix;
454             #pod
455             #pod This method returns the currently-set prefix for the logger, which may be a
456             #pod string or code reference or undef. See L<Logger Prefix|/LOGGER PREFIX>.
457             #pod
458             #pod =method set_prefix
459             #pod
460             #pod $logger->set_prefix( $new_prefix );
461             #pod
462             #pod This method changes the prefix. See L<Logger Prefix|/LOGGER PREFIX>.
463             #pod
464             #pod =method clear_prefix
465             #pod
466             #pod This method clears any set logger prefix. (It can also be called as
467             #pod C<unset_prefix>, but this is deprecated. See L<Logger Prefix|/LOGGER PREFIX>.
468             #pod
469             #pod =cut
470              
471 39     39 1 265 sub get_prefix { return $_[0]->{prefix} }
472 3     3 1 11 sub set_prefix { $_[0]->{prefix} = $_[1] }
473 2     2 1 10 sub clear_prefix { $_[0]->unset_prefix }
474 2     2 0 7 sub unset_prefix { undef $_[0]->{prefix} }
475              
476             #pod =method ident
477             #pod
478             #pod This method returns the logger's ident.
479             #pod
480             #pod =cut
481              
482 7     7 1 2646 sub ident { $_[0]{ident} }
483              
484             #pod =method config_id
485             #pod
486             #pod This method returns the logger's configuration id, which defaults to its ident.
487             #pod This can be used to make two loggers equivalent in Log::Dispatchouli::Global so
488             #pod that trying to reinitialize with a new logger with the same C<config_id> as the
489             #pod current logger will not throw an exception, and will simply do no thing.
490             #pod
491             #pod =cut
492              
493 0     0 1 0 sub config_id { $_[0]{config_id} }
494              
495             #pod =head1 METHODS FOR SUBCLASSING
496             #pod
497             #pod =head2 string_flogger
498             #pod
499             #pod This method returns the thing on which F<flog> will be called to format log
500             #pod messages. By default, it just returns C<String::Flogger>
501             #pod
502             #pod =cut
503              
504 39     39 1 71 sub string_flogger { 'String::Flogger' }
505              
506             #pod =head2 env_prefix
507             #pod
508             #pod This method should return a string used as a prefix to find environment
509             #pod variables that affect the logger's behavior. For example, if this method
510             #pod returns C<XYZZY> then when checking the environment for a default value for the
511             #pod C<debug> parameter, Log::Dispatchouli will first check C<XYZZY_DEBUG>, then
512             #pod C<DISPATCHOULI_DEBUG>.
513             #pod
514             #pod By default, this method returns C<()>, which means no extra environment
515             #pod variable is checked.
516             #pod
517             #pod =cut
518              
519 15     15 1 35 sub env_prefix { return; }
520              
521             #pod =head2 env_value
522             #pod
523             #pod my $value = $logger->env_value('DEBUG');
524             #pod
525             #pod This method returns the value for the environment variable suffix given. For
526             #pod example, the example given, calling with C<DEBUG> will check
527             #pod C<DISPATCHOULI_DEBUG>.
528             #pod
529             #pod =cut
530              
531             sub env_value {
532 18     18 1 49 my ($self, $suffix) = @_;
533              
534 18         49 my @path = grep { defined } ($self->env_prefix, 'DISPATCHOULI');
  21         79  
535              
536 18         44 for my $prefix (@path) {
537 19         58 my $name = join q{_}, $prefix, $suffix;
538 19 100       83 return $ENV{ $name } if defined $ENV{ $name };
539             }
540              
541 13         48 return;
542             }
543              
544             #pod =head1 METHODS FOR TESTING
545             #pod
546             #pod =head2 new_tester
547             #pod
548             #pod my $logger = Log::Dispatchouli->new_tester( \%arg );
549             #pod
550             #pod This returns a new logger that logs only C<to_self>. It's useful in testing.
551             #pod If no C<ident> arg is provided, one will be generated. C<log_pid> is off by
552             #pod default, but can be overridden.
553             #pod
554             #pod C<\%arg> is optional.
555             #pod
556             #pod =cut
557              
558             sub new_tester {
559 10     10 1 2458 my ($class, $arg) = @_;
560 10   100     49 $arg ||= {};
561              
562 10         111 return $class->new({
563             ident => "$$:$0",
564             log_pid => 0,
565             %$arg,
566             to_stderr => 0,
567             to_stdout => 0,
568             to_file => 0,
569             to_self => 1,
570             facility => undef,
571             });
572             }
573              
574             #pod =head2 events
575             #pod
576             #pod This method returns the arrayref of events logged to an array in memory (in the
577             #pod logger). If the logger is not logging C<to_self> this raises an exception.
578             #pod
579             #pod =cut
580              
581             sub events {
582             Carp::confess "->events called on a logger not logging to self"
583 28 50   28 1 537 unless $_[0]->{events};
584              
585 28         145 return $_[0]->{events};
586             }
587              
588             #pod =head2 clear_events
589             #pod
590             #pod This method empties the current sequence of events logged into an array in
591             #pod memory. If the logger is not logging C<to_self> this raises an exception.
592             #pod
593             #pod =cut
594              
595             sub clear_events {
596             Carp::confess "->events called on a logger not logging to self"
597 15 50   15 1 5995 unless $_[0]->{events};
598              
599 15         22 @{ $_[0]->{events} } = ();
  15         52  
600 15         29 return;
601             }
602              
603             #pod =head1 METHODS FOR PROXY LOGGERS
604             #pod
605             #pod =head2 proxy
606             #pod
607             #pod my $proxy_logger = $logger->proxy( \%arg );
608             #pod
609             #pod This method returns a new proxy logger -- an instance of
610             #pod L<Log::Dispatchouli::Proxy> -- which will log through the given logger, but
611             #pod which may have some settings localized.
612             #pod
613             #pod C<%arg> is optional. It may contain the following entries:
614             #pod
615             #pod =for :list
616             #pod = proxy_prefix
617             #pod This is a prefix that will be applied to anything the proxy logger logs, and
618             #pod cannot be changed.
619             #pod = debug
620             #pod This can be set to true or false to change the proxy's "am I in debug mode?"
621             #pod setting. It can be changed or cleared later on the proxy.
622             #pod
623             #pod =cut
624              
625             sub proxy_class {
626 2     2 0 25 return 'Log::Dispatchouli::Proxy';
627             }
628              
629             sub proxy {
630 2     2 1 17 my ($self, $arg) = @_;
631 2   50     8 $arg ||= {};
632              
633             $self->proxy_class->_new({
634             parent => $self,
635             logger => $self,
636             proxy_prefix => $arg->{proxy_prefix},
637 2 0       8 (exists $arg->{debug} ? (debug => ($arg->{debug} ? 1 : 0)) : ()),
    50          
638             });
639             }
640              
641             #pod =head2 parent
642             #pod
643             #pod =head2 logger
644             #pod
645             #pod These methods return the logger itself. (They're more useful when called on
646             #pod proxy loggers.)
647             #pod
648             #pod =cut
649              
650 1     1 1 7 sub parent { $_[0] }
651 1     1 1 537 sub logger { $_[0] }
652              
653             #pod =method dispatcher
654             #pod
655             #pod This returns the underlying Log::Dispatch object. This is not the method
656             #pod you're looking for. Move along.
657             #pod
658             #pod =cut
659              
660 39     39 1 212 sub dispatcher { $_[0]->{dispatcher} }
661              
662             #pod =method stdio_dispatcher_class
663             #pod
664             #pod This method is an experimental feature to allow you to pick an alternate
665             #pod dispatch class for stderr and stdio. By default, Log::Dispatch::Screen is
666             #pod used. B<This feature may go away at any time.>
667             #pod
668             #pod =cut
669              
670             sub stdio_dispatcher_class {
671 0     0 1 0 require Log::Dispatch::Screen;
672 0         0 return 'Log::Dispatch::Screen';
673             }
674              
675             #pod =head1 METHODS FOR API COMPATIBILITY
676             #pod
677             #pod To provide compatibility with some other loggers, most specifically
678             #pod L<Log::Contextual>, the following methods are provided. You should not use
679             #pod these methods without a good reason, and you should never subclass them.
680             #pod Instead, subclass the methods they call.
681             #pod
682             #pod =begin :list
683             #pod
684             #pod = is_debug
685             #pod
686             #pod This method calls C<get_debug>.
687             #pod
688             #pod = is_info
689             #pod
690             #pod = is_fatal
691             #pod
692             #pod These methods return true.
693             #pod
694             #pod = info
695             #pod
696             #pod = fatal
697             #pod
698             #pod = debug
699             #pod
700             #pod These methods redispatch to C<log>, C<log_fatal>, and C<log_debug>
701             #pod respectively.
702             #pod
703             #pod =end :list
704             #pod
705             #pod =cut
706              
707 11     11 1 45 sub is_debug { $_[0]->get_debug }
708 0     0 1   sub is_info { 1 }
709 0     0 1   sub is_fatal { 1 }
710              
711 0     0 1   sub info { shift()->log(@_); }
712 0     0 1   sub fatal { shift()->log_fatal(@_); }
713 0     0 1   sub debug { shift()->log_debug(@_); }
714              
715             use overload
716 0     0   0 '&{}' => sub { my ($self) = @_; sub { $self->log(@_) } },
  0         0  
  0         0  
717 6         67 fallback => 1,
718 6     6   61 ;
  6         14  
719              
720             #pod =head1 SEE ALSO
721             #pod
722             #pod =for :list
723             #pod * L<Log::Dispatch>
724             #pod * L<String::Flogger>
725             #pod
726             #pod =cut
727              
728             1;
729              
730             __END__
731              
732             =pod
733              
734             =encoding UTF-8
735              
736             =head1 NAME
737              
738             Log::Dispatchouli - a simple wrapper around Log::Dispatch
739              
740             =head1 VERSION
741              
742             version 2.022
743              
744             =head1 SYNOPSIS
745              
746             my $logger = Log::Dispatchouli->new({
747             ident => 'stuff-purger',
748             facility => 'daemon',
749             to_stdout => $opt->{print},
750             debug => $opt->{verbose}
751             });
752              
753             $logger->log([ "There are %s items left to purge...", $stuff_left ]);
754              
755             $logger->log_debug("this is extra often-ignored debugging log");
756              
757             $logger->log_fatal("Now we will die!!");
758              
759             =head1 DESCRIPTION
760              
761             Log::Dispatchouli is a thin layer above L<Log::Dispatch> and meant to make it
762             dead simple to add logging to a program without having to think much about
763             categories, facilities, levels, or things like that. It is meant to make
764             logging just configurable enough that you can find the logs you want and just
765             easy enough that you will actually log things.
766              
767             Log::Dispatchouli can log to syslog (if you specify a facility), standard error
768             or standard output, to a file, or to an array in memory. That last one is
769             mostly useful for testing.
770              
771             In addition to providing as simple a way to get a handle for logging
772             operations, Log::Dispatchouli uses L<String::Flogger> to process the things to
773             be logged, meaning you can easily log data structures. Basically: strings are
774             logged as is, arrayrefs are taken as (sprintf format, args), and subroutines
775             are called only if needed. For more information read the L<String::Flogger>
776             docs.
777              
778             =head1 METHODS
779              
780             =head2 new
781              
782             my $logger = Log::Dispatchouli->new(\%arg);
783              
784             This returns a new logger, a Log::Dispatchouli object.
785              
786             Valid arguments are:
787              
788             ident - the name of the thing logging (mandatory)
789             to_self - log to the logger object for testing; default: false
790             to_stdout - log to STDOUT; default: false
791             to_stderr - log to STDERR; default: false
792             facility - to which syslog facility to send logs; default: none
793              
794             to_file - log to PROGRAM_NAME.YYYYMMDD in the log path; default: false
795             log_file - a leaf name for the file to log to with to_file
796             log_path - path in which to log to file; defaults to DISPATCHOULI_PATH
797             environment variable or, failing that, to your system's tmpdir
798              
799             file_format - this optional coderef is passed the message to be logged
800             and returns the text to write out
801              
802             log_pid - if true, prefix all log entries with the pid; default: true
803             fail_fatal - a boolean; if true, failure to log is fatal; default: true
804             muted - a boolean; if true, only fatals are logged; default: false
805             debug - a boolean; if true, log_debug method is not a no-op
806             defaults to the truth of the DISPATCHOULI_DEBUG env var
807             quiet_fatal - 'stderr' or 'stdout' or an arrayref of zero, one, or both
808             fatal log messages will not be logged to these
809             (default: stderr)
810             config_id - a name for this logger's config; rarely needed!
811             syslog_socket - a value for Sys::Syslog's "socket" arg; default: "native"
812              
813             The log path is either F</tmp> or the value of the F<DISPATCHOULI_PATH> env var.
814              
815             If the F<DISPATCHOULI_NOSYSLOG> env var is true, we don't log to syslog.
816              
817             =head2 log
818              
819             $logger->log(@messages);
820              
821             $logger->log(\%arg, @messages);
822              
823             This method uses L<String::Flogger> on the input, then I<unconditionally> logs
824             the result. Each message is flogged individually, then joined with spaces.
825              
826             If the first argument is a hashref, it will be used as extra arguments to
827             logging. It may include a C<prefix> entry to preprocess the message by
828             prepending a string (if the prefix is a string) or calling a subroutine to
829             generate a new message (if the prefix is a coderef).
830              
831             =head2 log_fatal
832              
833             This behaves like the C<log> method, but will throw the logged string as an
834             exception after logging.
835              
836             This method can also be called as C<fatal>, to match other popular logging
837             interfaces. B<If you want to override this method, you must override
838             C<log_fatal> and not C<fatal>>.
839              
840             =head2 log_debug
841              
842             This behaves like the C<log> method, but will only log (at the debug level) if
843             the logger object has its debug property set to true.
844              
845             This method can also be called as C<debug>, to match other popular logging
846             interfaces. B<If you want to override this method, you must override
847             C<log_debug> and not C<debug>>.
848              
849             =head2 set_debug
850              
851             $logger->set_debug($bool);
852              
853             This sets the logger's debug property, which affects the behavior of
854             C<log_debug>.
855              
856             =head2 get_debug
857              
858             This gets the logger's debug property, which affects the behavior of
859             C<log_debug>.
860              
861             =head2 clear_debug
862              
863             This method does nothing, and is only useful for L<Log::Dispatchouli::Proxy>
864             objects. See L<Methods for Proxy Loggers|/METHODS FOR PROXY LOGGERS>, below.
865              
866             =head2 set_muted
867              
868             $logger->set_muted($bool);
869              
870             This sets the logger's muted property, which affects the behavior of
871             C<log>.
872              
873             =head2 get_muted
874              
875             This gets the logger's muted property, which affects the behavior of
876             C<log>.
877              
878             =head2 clear_muted
879              
880             This method does nothing, and is only useful for L<Log::Dispatchouli::Proxy>
881             objects. See L<Methods for Proxy Loggers|/METHODS FOR PROXY LOGGERS>, below.
882              
883             =head2 get_prefix
884              
885             my $prefix = $logger->get_prefix;
886              
887             This method returns the currently-set prefix for the logger, which may be a
888             string or code reference or undef. See L<Logger Prefix|/LOGGER PREFIX>.
889              
890             =head2 set_prefix
891              
892             $logger->set_prefix( $new_prefix );
893              
894             This method changes the prefix. See L<Logger Prefix|/LOGGER PREFIX>.
895              
896             =head2 clear_prefix
897              
898             This method clears any set logger prefix. (It can also be called as
899             C<unset_prefix>, but this is deprecated. See L<Logger Prefix|/LOGGER PREFIX>.
900              
901             =head2 ident
902              
903             This method returns the logger's ident.
904              
905             =head2 config_id
906              
907             This method returns the logger's configuration id, which defaults to its ident.
908             This can be used to make two loggers equivalent in Log::Dispatchouli::Global so
909             that trying to reinitialize with a new logger with the same C<config_id> as the
910             current logger will not throw an exception, and will simply do no thing.
911              
912             =head2 dispatcher
913              
914             This returns the underlying Log::Dispatch object. This is not the method
915             you're looking for. Move along.
916              
917             =head2 stdio_dispatcher_class
918              
919             This method is an experimental feature to allow you to pick an alternate
920             dispatch class for stderr and stdio. By default, Log::Dispatch::Screen is
921             used. B<This feature may go away at any time.>
922              
923             =head1 LOGGER PREFIX
924              
925             Log messages may be prepended with information to set context. This can be set
926             at a logger level or per log item. The simplest example is:
927              
928             my $logger = Log::Dispatchouli->new( ... );
929              
930             $logger->set_prefix("Batch 123: ");
931              
932             $logger->log("begun processing");
933              
934             # ...
935              
936             $logger->log("finished processing");
937              
938             The above will log something like:
939              
940             Batch 123: begun processing
941             Batch 123: finished processing
942              
943             To pass a prefix per-message:
944              
945             $logger->log({ prefix => 'Sub-Item 234: ' }, 'error!')
946              
947             # Logs: Batch 123: Sub-Item 234: error!
948              
949             If the prefix is a string, it is prepended to each line of the message. If it
950             is a coderef, it is called and passed the message to be logged. The return
951             value is logged instead.
952              
953             L<Proxy loggers|/METHODS FOR PROXY LOGGERS> also have their own prefix
954             settings, which accumulate. So:
955              
956             my $proxy = $logger->proxy({ proxy_prefix => 'Subsystem 12: ' });
957              
958             $proxy->set_prefix('Page 9: ');
959              
960             $proxy->log({ prefix => 'Paragraph 6: ' }, 'Done.');
961              
962             ...will log...
963              
964             Batch 123: Subsystem 12: Page 9: Paragraph 6: Done.
965              
966             =head1 METHODS FOR SUBCLASSING
967              
968             =head2 string_flogger
969              
970             This method returns the thing on which F<flog> will be called to format log
971             messages. By default, it just returns C<String::Flogger>
972              
973             =head2 env_prefix
974              
975             This method should return a string used as a prefix to find environment
976             variables that affect the logger's behavior. For example, if this method
977             returns C<XYZZY> then when checking the environment for a default value for the
978             C<debug> parameter, Log::Dispatchouli will first check C<XYZZY_DEBUG>, then
979             C<DISPATCHOULI_DEBUG>.
980              
981             By default, this method returns C<()>, which means no extra environment
982             variable is checked.
983              
984             =head2 env_value
985              
986             my $value = $logger->env_value('DEBUG');
987              
988             This method returns the value for the environment variable suffix given. For
989             example, the example given, calling with C<DEBUG> will check
990             C<DISPATCHOULI_DEBUG>.
991              
992             =head1 METHODS FOR TESTING
993              
994             =head2 new_tester
995              
996             my $logger = Log::Dispatchouli->new_tester( \%arg );
997              
998             This returns a new logger that logs only C<to_self>. It's useful in testing.
999             If no C<ident> arg is provided, one will be generated. C<log_pid> is off by
1000             default, but can be overridden.
1001              
1002             C<\%arg> is optional.
1003              
1004             =head2 events
1005              
1006             This method returns the arrayref of events logged to an array in memory (in the
1007             logger). If the logger is not logging C<to_self> this raises an exception.
1008              
1009             =head2 clear_events
1010              
1011             This method empties the current sequence of events logged into an array in
1012             memory. If the logger is not logging C<to_self> this raises an exception.
1013              
1014             =head1 METHODS FOR PROXY LOGGERS
1015              
1016             =head2 proxy
1017              
1018             my $proxy_logger = $logger->proxy( \%arg );
1019              
1020             This method returns a new proxy logger -- an instance of
1021             L<Log::Dispatchouli::Proxy> -- which will log through the given logger, but
1022             which may have some settings localized.
1023              
1024             C<%arg> is optional. It may contain the following entries:
1025              
1026             =over 4
1027              
1028             =item proxy_prefix
1029              
1030             This is a prefix that will be applied to anything the proxy logger logs, and
1031             cannot be changed.
1032              
1033             =item debug
1034              
1035             This can be set to true or false to change the proxy's "am I in debug mode?"
1036             setting. It can be changed or cleared later on the proxy.
1037              
1038             =back
1039              
1040             =head2 parent
1041              
1042             =head2 logger
1043              
1044             These methods return the logger itself. (They're more useful when called on
1045             proxy loggers.)
1046              
1047             =head1 METHODS FOR API COMPATIBILITY
1048              
1049             To provide compatibility with some other loggers, most specifically
1050             L<Log::Contextual>, the following methods are provided. You should not use
1051             these methods without a good reason, and you should never subclass them.
1052             Instead, subclass the methods they call.
1053              
1054             =over 4
1055              
1056             =item is_debug
1057              
1058             This method calls C<get_debug>.
1059              
1060             =item is_info
1061              
1062             =item is_fatal
1063              
1064             These methods return true.
1065              
1066             =item info
1067              
1068             =item fatal
1069              
1070             =item debug
1071              
1072             These methods redispatch to C<log>, C<log_fatal>, and C<log_debug>
1073             respectively.
1074              
1075             =back
1076              
1077             =head1 SEE ALSO
1078              
1079             =over 4
1080              
1081             =item *
1082              
1083             L<Log::Dispatch>
1084              
1085             =item *
1086              
1087             L<String::Flogger>
1088              
1089             =back
1090              
1091             =head1 AUTHOR
1092              
1093             Ricardo SIGNES <rjbs@cpan.org>
1094              
1095             =head1 CONTRIBUTORS
1096              
1097             =for stopwords Christopher J. Madsen Dagfinn Ilmari Mannsåker Dan Book George Hartzell Jon Stuart Matt Phillips Olivier Mengué Randy Stauner Ricardo Signes Sawyer X
1098              
1099             =over 4
1100              
1101             =item *
1102              
1103             Christopher J. Madsen <perl@cjmweb.net>
1104              
1105             =item *
1106              
1107             Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
1108              
1109             =item *
1110              
1111             Dan Book <grinnz@gmail.com>
1112              
1113             =item *
1114              
1115             George Hartzell <hartzell@alerce.com>
1116              
1117             =item *
1118              
1119             Jon Stuart <jon@fastmailteam.com>
1120              
1121             =item *
1122              
1123             Matt Phillips <mattp@cpan.org>
1124              
1125             =item *
1126              
1127             Olivier Mengué <dolmen@cpan.org>
1128              
1129             =item *
1130              
1131             Randy Stauner <randy@magnificent-tears.com>
1132              
1133             =item *
1134              
1135             Ricardo Signes <rjbs@semiotic.systems>
1136              
1137             =item *
1138              
1139             Ricardo Signes <rjbs@users.noreply.github.com>
1140              
1141             =item *
1142              
1143             Sawyer X <xsawyerx@cpan.org>
1144              
1145             =back
1146              
1147             =head1 COPYRIGHT AND LICENSE
1148              
1149             This software is copyright (c) 2020 by Ricardo SIGNES.
1150              
1151             This is free software; you can redistribute it and/or modify it under
1152             the same terms as the Perl 5 programming language system itself.
1153              
1154             =cut