File Coverage

blib/lib/Log/Dispatchouli.pm
Criterion Covered Total %
statement 133 163 81.6
branch 43 78 55.1
condition 12 20 60.0
subroutine 41 58 70.6
pod 32 37 86.4
total 261 356 73.3


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