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   110215 use strict;
  6         171  
  6         187  
2 6     6   32 use warnings;
  6         12  
  6         255  
3             package Log::Dispatchouli;
4             # ABSTRACT: a simple wrapper around Log::Dispatch
5             $Log::Dispatchouli::VERSION = '2.023';
6 6     6   30 use Carp ();
  6         12  
  6         115  
7 6     6   31 use File::Spec ();
  6         13  
  6         155  
8 6     6   3431 use Log::Dispatch;
  6         1561107  
  6         246  
9 6     6   3213 use Params::Util qw(_ARRAY0 _HASH0 _CODELIKE);
  6         23136  
  6         467  
10 6     6   53 use Scalar::Util qw(blessed weaken);
  6         11  
  6         289  
11 6     6   3003 use String::Flogger;
  6         67073  
  6         98  
12 6     6   1248 use Try::Tiny 0.04;
  6         135  
  6         6668  
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 8114 my ($class, $arg) = @_;
136              
137             my $ident = $arg->{ident}
138 20 100       287 or Carp::croak "no ident specified when using $class";
139              
140 19 50       78 my $config_id = defined $arg->{config_id} ? $arg->{config_id} : $ident;
141              
142 19         37 my %quiet_fatal;
143 19         51 for ('quiet_fatal') {
144 19         100 %quiet_fatal = map {; $_ => 1 } grep { defined }
  19         68  
145             exists $arg->{$_}
146 19 0       76 ? _ARRAY0($arg->{$_}) ? @{ $arg->{$_} } : $arg->{$_}
  0 50       0  
147             : ('stderr');
148             };
149              
150 19         117 my $log = Log::Dispatch->new;
151             my $self = bless {
152             dispatcher => $log,
153 19 100       1283 log_pid => (exists $arg->{log_pid} ? $arg->{log_pid} : 1),
154             } => $class;
155              
156 19 100       151 if ($arg->{to_file}) {
157 2         521 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     70930 $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         9 callbacks => do {
177 2 100       7 if (my $format = $arg->{file_format}) {
178             sub {
179 1     1   97 my $message = {@_}->{message};
180 1 50       6 $message = "[$$] $message" if $self->{log_pid};
181 1         5 $format->($message)
182 1         10 };
183             } else {
184             # The time format returned here is subject to change. -- rjbs,
185             # 2008-11-21
186             sub {
187 1     1   134 my $message = {@_}->{message};
188 1 50       7 $message = "[$$] $message" if $self->{log_pid};
189 1         37 (localtime) . " $message\n";
190 1         15 };
191             }
192             },
193             )
194             );
195             }
196              
197 19 50 33     977 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       61 if ($arg->{to_self}) {
206 16         195 $self->{events} = [];
207 16         2527 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   298 ($self->{log_pid} ? (callbacks => sub { "[$$] ". {@_}->{message} })
214 16 100       184803 : ())
215             ),
216             );
217             }
218              
219 19         2313 $self->{prefix} = $arg->{prefix};
220 19         48 $self->{ident} = $ident;
221 19         50 $self->{config_id} = $config_id;
222              
223 19         54 DEST: for my $dest (qw(err out)) {
224 38 50       165 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       109 ? ($arg->{debug} ? 1 : 0)
    100          
    100          
232             : ($self->env_value('DEBUG') ? 1 : 0);
233 19         67 $self->{muted} = $arg->{muted};
234              
235 19         51 $self->{quiet_fatal} = \%quiet_fatal;
236 19 50       59 $self->{fail_fatal} = exists $arg->{fail_fatal} ? $arg->{fail_fatal} : 1;
237              
238 19         96 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         11073  
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         4  
  1         5  
301              
302             sub log {
303 41     41 1 3879 my ($self, @rest) = @_;
304 41 100       187 my $arg = _HASH0($rest[0]) ? shift(@rest) : {};
305              
306 41         72 my $message;
307              
308 41 100 100     169 if ($arg->{fatal} or ! $self->get_muted) {
309             try {
310 39     39   2078 my $flogger = $self->string_flogger;
311 39         92 my @flogged = map {; $flogger->flog($_) } @rest;
  40         273  
312 39 100       923 $message = @flogged > 1 ? $self->_join(\@flogged) : $flogged[0];
313              
314             my $prefix = _ARRAY0($arg->{prefix})
315 15         36 ? [ @{ $arg->{prefix} } ]
316 39 100       187 : [ $arg->{prefix} ];
317              
318 39         122 for (reverse grep { defined } $self->get_prefix, @$prefix) {
  116         252  
319 54 100       120 if (_CODELIKE( $_ )) {
320 1         4 $message = $_->($message);
321             } else {
322 53         208 $message =~ s/^/$_/gm;
323             }
324             }
325              
326             $self->dispatcher->log(
327 39   100     120 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         350 };
334             }
335              
336 41 100       5101 Carp::croak $message if $arg->{fatal};
337              
338 38         141 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 23834 my ($self, @rest) = @_;
354              
355 3 50       22 my $arg = _HASH0($rest[0]) ? shift(@rest) : {}; # for future expansion
356              
357 3 50       17 local $arg->{level} = defined $arg->{level} ? $arg->{level} : 'error';
358 3 50       15 local $arg->{fatal} = defined $arg->{fatal} ? $arg->{fatal} : 1;
359              
360 3         16 $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 588 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 60 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 9 sub mute { $_[0]{muted} = 1 }
418 3     3 0 18 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 182 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 336 sub get_prefix { return $_[0]->{prefix} }
472 3     3 1 13 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 3075 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 85 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 38 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 52 my ($self, $suffix) = @_;
533              
534 18         69 my @path = grep { defined } ($self->env_prefix, 'DISPATCHOULI');
  21         101  
535              
536 18         48 for my $prefix (@path) {
537 19         64 my $name = join q{_}, $prefix, $suffix;
538 19 100       96 return $ENV{ $name } if defined $ENV{ $name };
539             }
540              
541 13         52 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 2785 my ($class, $arg) = @_;
560 10   100     56 $arg ||= {};
561              
562 10         166 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 586 unless $_[0]->{events};
584              
585 28         176 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 6808 unless $_[0]->{events};
598              
599 15         26 @{ $_[0]->{events} } = ();
  15         53  
600 15         30 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 26 return 'Log::Dispatchouli::Proxy';
627             }
628              
629             sub proxy {
630 2     2 1 22 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 6 sub parent { $_[0] }
651 1     1 1 535 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 235 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 49 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         79 fallback => 1,
718 6     6   58 ;
  6         13  
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.023
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 PERL VERSION SUPPORT
779              
780             This module has a long-term perl support period. That means it will not
781             require a version of perl released fewer than five years ago.
782              
783             Although it may work on older versions of perl, no guarantee is made that the
784             minimum required version will not be increased. The version may be increased
785             for any reason, and there is no promise that patches will be accepted to lower
786             the minimum required perl.
787              
788             =head1 METHODS
789              
790             =head2 new
791              
792             my $logger = Log::Dispatchouli->new(\%arg);
793              
794             This returns a new logger, a Log::Dispatchouli object.
795              
796             Valid arguments are:
797              
798             ident - the name of the thing logging (mandatory)
799             to_self - log to the logger object for testing; default: false
800             to_stdout - log to STDOUT; default: false
801             to_stderr - log to STDERR; default: false
802             facility - to which syslog facility to send logs; default: none
803              
804             to_file - log to PROGRAM_NAME.YYYYMMDD in the log path; default: false
805             log_file - a leaf name for the file to log to with to_file
806             log_path - path in which to log to file; defaults to DISPATCHOULI_PATH
807             environment variable or, failing that, to your system's tmpdir
808              
809             file_format - this optional coderef is passed the message to be logged
810             and returns the text to write out
811              
812             log_pid - if true, prefix all log entries with the pid; default: true
813             fail_fatal - a boolean; if true, failure to log is fatal; default: true
814             muted - a boolean; if true, only fatals are logged; default: false
815             debug - a boolean; if true, log_debug method is not a no-op
816             defaults to the truth of the DISPATCHOULI_DEBUG env var
817             quiet_fatal - 'stderr' or 'stdout' or an arrayref of zero, one, or both
818             fatal log messages will not be logged to these
819             (default: stderr)
820             config_id - a name for this logger's config; rarely needed!
821             syslog_socket - a value for Sys::Syslog's "socket" arg; default: "native"
822              
823             The log path is either F</tmp> or the value of the F<DISPATCHOULI_PATH> env var.
824              
825             If the F<DISPATCHOULI_NOSYSLOG> env var is true, we don't log to syslog.
826              
827             =head2 log
828              
829             $logger->log(@messages);
830              
831             $logger->log(\%arg, @messages);
832              
833             This method uses L<String::Flogger> on the input, then I<unconditionally> logs
834             the result. Each message is flogged individually, then joined with spaces.
835              
836             If the first argument is a hashref, it will be used as extra arguments to
837             logging. It may include a C<prefix> entry to preprocess the message by
838             prepending a string (if the prefix is a string) or calling a subroutine to
839             generate a new message (if the prefix is a coderef).
840              
841             =head2 log_fatal
842              
843             This behaves like the C<log> method, but will throw the logged string as an
844             exception after logging.
845              
846             This method can also be called as C<fatal>, to match other popular logging
847             interfaces. B<If you want to override this method, you must override
848             C<log_fatal> and not C<fatal>>.
849              
850             =head2 log_debug
851              
852             This behaves like the C<log> method, but will only log (at the debug level) if
853             the logger object has its debug property set to true.
854              
855             This method can also be called as C<debug>, to match other popular logging
856             interfaces. B<If you want to override this method, you must override
857             C<log_debug> and not C<debug>>.
858              
859             =head2 set_debug
860              
861             $logger->set_debug($bool);
862              
863             This sets the logger's debug property, which affects the behavior of
864             C<log_debug>.
865              
866             =head2 get_debug
867              
868             This gets the logger's debug property, which affects the behavior of
869             C<log_debug>.
870              
871             =head2 clear_debug
872              
873             This method does nothing, and is only useful for L<Log::Dispatchouli::Proxy>
874             objects. See L<Methods for Proxy Loggers|/METHODS FOR PROXY LOGGERS>, below.
875              
876             =head2 set_muted
877              
878             $logger->set_muted($bool);
879              
880             This sets the logger's muted property, which affects the behavior of
881             C<log>.
882              
883             =head2 get_muted
884              
885             This gets the logger's muted property, which affects the behavior of
886             C<log>.
887              
888             =head2 clear_muted
889              
890             This method does nothing, and is only useful for L<Log::Dispatchouli::Proxy>
891             objects. See L<Methods for Proxy Loggers|/METHODS FOR PROXY LOGGERS>, below.
892              
893             =head2 get_prefix
894              
895             my $prefix = $logger->get_prefix;
896              
897             This method returns the currently-set prefix for the logger, which may be a
898             string or code reference or undef. See L<Logger Prefix|/LOGGER PREFIX>.
899              
900             =head2 set_prefix
901              
902             $logger->set_prefix( $new_prefix );
903              
904             This method changes the prefix. See L<Logger Prefix|/LOGGER PREFIX>.
905              
906             =head2 clear_prefix
907              
908             This method clears any set logger prefix. (It can also be called as
909             C<unset_prefix>, but this is deprecated. See L<Logger Prefix|/LOGGER PREFIX>.
910              
911             =head2 ident
912              
913             This method returns the logger's ident.
914              
915             =head2 config_id
916              
917             This method returns the logger's configuration id, which defaults to its ident.
918             This can be used to make two loggers equivalent in Log::Dispatchouli::Global so
919             that trying to reinitialize with a new logger with the same C<config_id> as the
920             current logger will not throw an exception, and will simply do no thing.
921              
922             =head2 dispatcher
923              
924             This returns the underlying Log::Dispatch object. This is not the method
925             you're looking for. Move along.
926              
927             =head2 stdio_dispatcher_class
928              
929             This method is an experimental feature to allow you to pick an alternate
930             dispatch class for stderr and stdio. By default, Log::Dispatch::Screen is
931             used. B<This feature may go away at any time.>
932              
933             =head1 LOGGER PREFIX
934              
935             Log messages may be prepended with information to set context. This can be set
936             at a logger level or per log item. The simplest example is:
937              
938             my $logger = Log::Dispatchouli->new( ... );
939              
940             $logger->set_prefix("Batch 123: ");
941              
942             $logger->log("begun processing");
943              
944             # ...
945              
946             $logger->log("finished processing");
947              
948             The above will log something like:
949              
950             Batch 123: begun processing
951             Batch 123: finished processing
952              
953             To pass a prefix per-message:
954              
955             $logger->log({ prefix => 'Sub-Item 234: ' }, 'error!')
956              
957             # Logs: Batch 123: Sub-Item 234: error!
958              
959             If the prefix is a string, it is prepended to each line of the message. If it
960             is a coderef, it is called and passed the message to be logged. The return
961             value is logged instead.
962              
963             L<Proxy loggers|/METHODS FOR PROXY LOGGERS> also have their own prefix
964             settings, which accumulate. So:
965              
966             my $proxy = $logger->proxy({ proxy_prefix => 'Subsystem 12: ' });
967              
968             $proxy->set_prefix('Page 9: ');
969              
970             $proxy->log({ prefix => 'Paragraph 6: ' }, 'Done.');
971              
972             ...will log...
973              
974             Batch 123: Subsystem 12: Page 9: Paragraph 6: Done.
975              
976             =head1 METHODS FOR SUBCLASSING
977              
978             =head2 string_flogger
979              
980             This method returns the thing on which F<flog> will be called to format log
981             messages. By default, it just returns C<String::Flogger>
982              
983             =head2 env_prefix
984              
985             This method should return a string used as a prefix to find environment
986             variables that affect the logger's behavior. For example, if this method
987             returns C<XYZZY> then when checking the environment for a default value for the
988             C<debug> parameter, Log::Dispatchouli will first check C<XYZZY_DEBUG>, then
989             C<DISPATCHOULI_DEBUG>.
990              
991             By default, this method returns C<()>, which means no extra environment
992             variable is checked.
993              
994             =head2 env_value
995              
996             my $value = $logger->env_value('DEBUG');
997              
998             This method returns the value for the environment variable suffix given. For
999             example, the example given, calling with C<DEBUG> will check
1000             C<DISPATCHOULI_DEBUG>.
1001              
1002             =head1 METHODS FOR TESTING
1003              
1004             =head2 new_tester
1005              
1006             my $logger = Log::Dispatchouli->new_tester( \%arg );
1007              
1008             This returns a new logger that logs only C<to_self>. It's useful in testing.
1009             If no C<ident> arg is provided, one will be generated. C<log_pid> is off by
1010             default, but can be overridden.
1011              
1012             C<\%arg> is optional.
1013              
1014             =head2 events
1015              
1016             This method returns the arrayref of events logged to an array in memory (in the
1017             logger). If the logger is not logging C<to_self> this raises an exception.
1018              
1019             =head2 clear_events
1020              
1021             This method empties the current sequence of events logged into an array in
1022             memory. If the logger is not logging C<to_self> this raises an exception.
1023              
1024             =head1 METHODS FOR PROXY LOGGERS
1025              
1026             =head2 proxy
1027              
1028             my $proxy_logger = $logger->proxy( \%arg );
1029              
1030             This method returns a new proxy logger -- an instance of
1031             L<Log::Dispatchouli::Proxy> -- which will log through the given logger, but
1032             which may have some settings localized.
1033              
1034             C<%arg> is optional. It may contain the following entries:
1035              
1036             =over 4
1037              
1038             =item proxy_prefix
1039              
1040             This is a prefix that will be applied to anything the proxy logger logs, and
1041             cannot be changed.
1042              
1043             =item debug
1044              
1045             This can be set to true or false to change the proxy's "am I in debug mode?"
1046             setting. It can be changed or cleared later on the proxy.
1047              
1048             =back
1049              
1050             =head2 parent
1051              
1052             =head2 logger
1053              
1054             These methods return the logger itself. (They're more useful when called on
1055             proxy loggers.)
1056              
1057             =head1 METHODS FOR API COMPATIBILITY
1058              
1059             To provide compatibility with some other loggers, most specifically
1060             L<Log::Contextual>, the following methods are provided. You should not use
1061             these methods without a good reason, and you should never subclass them.
1062             Instead, subclass the methods they call.
1063              
1064             =over 4
1065              
1066             =item is_debug
1067              
1068             This method calls C<get_debug>.
1069              
1070             =item is_info
1071              
1072             =item is_fatal
1073              
1074             These methods return true.
1075              
1076             =item info
1077              
1078             =item fatal
1079              
1080             =item debug
1081              
1082             These methods redispatch to C<log>, C<log_fatal>, and C<log_debug>
1083             respectively.
1084              
1085             =back
1086              
1087             =head1 SEE ALSO
1088              
1089             =over 4
1090              
1091             =item *
1092              
1093             L<Log::Dispatch>
1094              
1095             =item *
1096              
1097             L<String::Flogger>
1098              
1099             =back
1100              
1101             =head1 AUTHOR
1102              
1103             Ricardo SIGNES <rjbs@semiotic.systems>
1104              
1105             =head1 CONTRIBUTORS
1106              
1107             =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
1108              
1109             =over 4
1110              
1111             =item *
1112              
1113             Christopher J. Madsen <perl@cjmweb.net>
1114              
1115             =item *
1116              
1117             Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
1118              
1119             =item *
1120              
1121             Dan Book <grinnz@gmail.com>
1122              
1123             =item *
1124              
1125             George Hartzell <hartzell@alerce.com>
1126              
1127             =item *
1128              
1129             Jon Stuart <jon@fastmailteam.com>
1130              
1131             =item *
1132              
1133             Matt Phillips <mattp@cpan.org>
1134              
1135             =item *
1136              
1137             Olivier Mengué <dolmen@cpan.org>
1138              
1139             =item *
1140              
1141             Randy Stauner <randy@magnificent-tears.com>
1142              
1143             =item *
1144              
1145             Ricardo Signes <rjbs@users.noreply.github.com>
1146              
1147             =item *
1148              
1149             Sawyer X <xsawyerx@cpan.org>
1150              
1151             =back
1152              
1153             =head1 COPYRIGHT AND LICENSE
1154              
1155             This software is copyright (c) 2021 by Ricardo SIGNES.
1156              
1157             This is free software; you can redistribute it and/or modify it under
1158             the same terms as the Perl 5 programming language system itself.
1159              
1160             =cut