File Coverage

blib/lib/AnyEvent/Log.pm
Criterion Covered Total %
statement 64 155 41.2
branch 19 60 31.6
condition 6 32 18.7
subroutine 20 43 46.5
pod 8 8 100.0
total 117 298 39.2


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             AnyEvent::Log - simple logging "framework"
4              
5             =head1 SYNOPSIS
6              
7             Simple uses:
8              
9             use AnyEvent;
10              
11             AE::log fatal => "No config found, cannot continue!"; # never returns
12             AE::log alert => "The battery died!";
13             AE::log crit => "The battery is too hot!";
14             AE::log error => "Division by zero attempted.";
15             AE::log warn => "Couldn't delete the file.";
16             AE::log note => "Attempted to create config, but config already exists.";
17             AE::log info => "File soandso successfully deleted.";
18             AE::log debug => "the function returned 3";
19             AE::log trace => "going to call function abc";
20              
21             Log level overview:
22              
23             LVL NAME SYSLOG PERL NOTE
24             1 fatal emerg exit system unusable, aborts program!
25             2 alert failure in primary system
26             3 critical crit failure in backup system
27             4 error err die non-urgent program errors, a bug
28             5 warn warning possible problem, not necessarily error
29             6 note notice unusual conditions
30             7 info normal messages, no action required
31             8 debug debugging messages for development
32             9 trace copious tracing output
33              
34             "Complex" uses (for speed sensitive code, e.g. trace/debug messages):
35              
36             use AnyEvent::Log;
37              
38             my $tracer = AnyEvent::Log::logger trace => \my $trace;
39              
40             $tracer->("i am here") if $trace;
41             $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
42              
43             Configuration (also look at the EXAMPLES section):
44              
45             # set default logging level to suppress anything below "notice"
46             # i.e. enable logging at "notice" or above - the default is to
47             # to not log anything at all.
48             $AnyEvent::Log::FILTER->level ("notice");
49              
50             # set logging for the current package to errors and higher only
51             AnyEvent::Log::ctx->level ("error");
52              
53             # enable logging for the current package, regardless of global logging level
54             AnyEvent::Log::ctx->attach ($AnyEvent::Log::LOG);
55              
56             # enable debug logging for module some::mod and enable logging by default
57             (AnyEvent::Log::ctx "some::mod")->level ("debug");
58             (AnyEvent::Log::ctx "some::mod")->attach ($AnyEvent::Log::LOG);
59              
60             # send all critical and higher priority messages to syslog,
61             # regardless of (most) other settings
62             $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
63             level => "critical",
64             log_to_syslog => "user",
65             );
66              
67             =head1 DESCRIPTION
68              
69             This module implements a relatively simple "logging framework". It doesn't
70             attempt to be "the" logging solution or even "a" logging solution for
71             AnyEvent - AnyEvent simply creates logging messages internally, and this
72             module more or less exposes the mechanism, with some extra spiff to allow
73             using it from other modules as well.
74              
75             Remember that the default verbosity level is C<4> (C<error>), so only
76             errors and more important messages will be logged, unless you set
77             C<PERL_ANYEVENT_VERBOSE> to a higher number before starting your program
78             (C<AE_VERBOSE=5> is recommended during development), or change the logging
79             level at runtime with something like:
80              
81             use AnyEvent::Log;
82             $AnyEvent::Log::FILTER->level ("info");
83              
84             The design goal behind this module was to keep it simple (and small),
85             but make it powerful enough to be potentially useful for any module,
86             and extensive enough for the most common tasks, such as logging to
87             multiple targets, or being able to log into a database.
88              
89             The module is also usable before AnyEvent itself is initialised, in which
90             case some of the functionality might be reduced.
91              
92             The amount of documentation might indicate otherwise, but the runtime part
93             of the module is still just below 300 lines of code.
94              
95             =head1 LOGGING LEVELS
96              
97             Logging levels in this module range from C<1> (highest priority) to C<9>
98             (lowest priority). Note that the lowest numerical value is the highest
99             priority, so when this document says "higher priority" it means "lower
100             numerical value".
101              
102             Instead of specifying levels by name you can also specify them by aliases:
103              
104             LVL NAME SYSLOG PERL NOTE
105             1 fatal emerg exit system unusable, aborts program!
106             2 alert failure in primary system
107             3 critical crit failure in backup system
108             4 error err die non-urgent program errors, a bug
109             5 warn warning possible problem, not necessarily error
110             6 note notice unusual conditions
111             7 info normal messages, no action required
112             8 debug debugging messages for development
113             9 trace copious tracing output
114              
115             As you can see, some logging levels have multiple aliases - the first one
116             is the "official" name, the second one the "syslog" name (if it differs)
117             and the third one the "perl" name, suggesting (only!) that you log C<die>
118             messages at C<error> priority. The NOTE column tries to provide some
119             rationale on how to chose a logging level.
120              
121             As a rough guideline, levels 1..3 are primarily meant for users of the
122             program (admins, staff), and are the only ones logged to STDERR by
123             default. Levels 4..6 are meant for users and developers alike, while
124             levels 7..9 are usually meant for developers.
125              
126             You can normally only log a message once at highest priority level (C<1>,
127             C<fatal>), because logging a fatal message will also quit the program - so
128             use it sparingly :)
129              
130             For example, a program that finds an unknown switch on the commandline
131             might well use a fatal logging level to tell users about it - the "system"
132             in this case would be the program, or module.
133              
134             Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
135             or C<all> - these are only valid for the methods that documented them.
136              
137             =head1 LOGGING FUNCTIONS
138              
139             The following functions allow you to log messages. They always use the
140             caller's package as a "logging context". Also, the main logging function,
141             C<log>, is aliased to C<AnyEvent::log> and C<AE::log> when the C<AnyEvent>
142             module is loaded.
143              
144             =over 4
145              
146             =cut
147              
148             package AnyEvent::Log;
149              
150 1     1   6 use Carp ();
  1         1  
  1         17  
151 1     1   4 use POSIX ();
  1         1  
  1         11  
152              
153             # layout of a context
154             # 0 1 2 3 4, 5
155             # [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
156              
157 1     1   3 use AnyEvent (); BEGIN { AnyEvent::common_sense }
  1     1   2  
  1         29  
  1         4  
158             #use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
159              
160             our $VERSION = $AnyEvent::VERSION;
161              
162             our ($COLLECT, $FILTER, $LOG);
163              
164             our ($now_int, $now_str1, $now_str2);
165              
166             # Format Time, not public - yet?
167             sub format_time($) {
168 0     0 1 0 my $i = int $_[0];
169 0         0 my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
170              
171 0 0       0 ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
172             if $now_int != $i;
173              
174 0         0 "$now_str1$f$now_str2"
175             }
176              
177             our %CTX; # all package contexts
178              
179             # creates a default package context object for the given package
180             sub _pkg_ctx($) {
181 2     2   8 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
182              
183             # link "parent" package
184             my $parent = $_[0] =~ /^(.+)::/
185 2 100 33     20 ? $CTX{$1} ||= &_pkg_ctx ("$1")
186             : $COLLECT;
187              
188 2         6 $ctx->[2]{$parent+0} = $parent;
189              
190 2         8 $ctx
191             }
192              
193             =item AnyEvent::Log::log $level, $msg[, @args]
194              
195             Requests logging of the given C<$msg> with the given log level, and
196             returns true if the message was logged I<somewhere>.
197              
198             For loglevel C<fatal>, the program will abort.
199              
200             If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
201             C<$msg> is interpreted as an sprintf format string.
202              
203             The C<$msg> should not end with C<\n>, but may if that is convenient for
204             you. Also, multiline messages are handled properly.
205              
206             Last not least, C<$msg> might be a code reference, in which case it is
207             supposed to return the message. It will be called only then the message
208             actually gets logged, which is useful if it is costly to create the
209             message in the first place.
210              
211             This function takes care of saving and restoring C<$!> and C<$@>, so you
212             don't have to.
213              
214             Whether the given message will be logged depends on the maximum log level
215             and the caller's package. The return value can be used to ensure that
216             messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
217             runtime error it tries to log it at C<die> level, but if that message is
218             lost it simply uses warn.
219              
220             Note that you can (and should) call this function as C<AnyEvent::log> or
221             C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
222             need any additional functionality), as those functions will load the
223             logging module on demand only. They are also much shorter to write.
224              
225             Also, if you optionally generate a lot of debug messages (such as when
226             tracing some code), you should look into using a logger callback and a
227             boolean enabler (see C<logger>, below).
228              
229             Example: log something at error level.
230              
231             AE::log error => "something";
232              
233             Example: use printf-formatting.
234              
235             AE::log info => "%5d %-10.10s %s", $index, $category, $msg;
236              
237             Example: only generate a costly dump when the message is actually being logged.
238              
239             AE::log debug => sub { require Data::Dump; Data::Dump::dump \%cache };
240              
241             =cut
242              
243             # also allow syslog equivalent names
244             our %STR2LEVEL = (
245             fatal => 1, emerg => 1, exit => 1,
246             alert => 2,
247             critical => 3, crit => 3,
248             error => 4, err => 4, die => 4,
249             warn => 5, warning => 5,
250             note => 6, notice => 6,
251             info => 7,
252             debug => 8,
253             trace => 9,
254             );
255              
256             our $TIME_EXACT;
257              
258             sub exact_time($) {
259 2     2 1 4 $TIME_EXACT = shift;
260             *_ts = $AnyEvent::MODEL
261             ? $TIME_EXACT ? \&AE::now : \&AE::time
262 2 50   0   2848 : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
  0 0       0  
  0 50       0  
  0         0  
263             }
264              
265             BEGIN {
266 1     1   4 exact_time 0;
267             }
268              
269             AnyEvent::post_detect {
270             exact_time $TIME_EXACT;
271             };
272              
273             our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
274              
275             # time, ctx, level, msg
276             sub default_format($$$$) {
277 0     0 1 0 my $ts = format_time $_[0];
278 0         0 my $ct = " ";
279              
280 0         0 my @res;
281              
282 0         0 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
283 0         0 push @res, "$ts$ct$_\n";
284 0         0 $ct = " + ";
285             }
286              
287 0         0 join "", @res
288             }
289              
290             sub fatal_exit() {
291 0     0 1 0 exit 1;
292             }
293              
294             sub _log {
295 1     1   3 my ($ctx, $level, $format, @args) = @_;
296              
297             $level = $level > 0 && $level <= 9
298             ? $level+0
299 1 50 33     6 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
      0        
300              
301 1         2 my $mask = 1 << $level;
302              
303 1         3 my ($success, %seen, @ctx, $now, @fmt);
304              
305             do
306 1         2 {
307             # if !ref, then it's a level number
308 4 50 66     25 if (!ref $ctx) {
    100          
309 0         0 $level = $ctx;
310             } elsif ($ctx->[1] & $mask and !$seen{$ctx+0}++) {
311             # logging/recursing into this context
312              
313             # level cap
314 3 50       6 if ($ctx->[5] > $level) {
315 0         0 push @ctx, $level; # restore level when going up in tree
316 0         0 $level = $ctx->[5];
317             }
318              
319             # log if log cb
320 3 50       5 if ($ctx->[3]) {
321             # logging target found
322              
323 0         0 local ($!, $@);
324              
325             # now get raw message, unless we have it already
326 0 0       0 unless ($now) {
327 0 0       0 $format = $format->() if ref $format;
328 0 0       0 $format = sprintf $format, @args if @args;
329 0         0 $format =~ s/\n$//;
330 0         0 $now = _ts;
331             };
332              
333             # format msg
334 0 0 0     0 my $str = $ctx->[4]
335             ? $ctx->[4]($now, $_[0], $level, $format)
336             : ($fmt[$level] ||= default_format $now, $_[0], $level, $format);
337              
338 0         0 $success = 1;
339              
340             $ctx->[3]($str)
341 0 0       0 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
  0         0  
342             } else {
343 3         4 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
  3         12  
344             }
345             }
346             }
347             while $ctx = pop @ctx;
348              
349 1 50       4 fatal_exit if $level <= 1;
350              
351 1         3 $success
352             }
353              
354             sub log($$;@) {
355             _log
356 1   33 1 1 9 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
357             @_;
358             }
359              
360             =item $logger = AnyEvent::Log::logger $level[, \$enabled]
361              
362             Creates a code reference that, when called, acts as if the
363             C<AnyEvent::Log::log> function was called at this point with the given
364             level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
365             the C<AnyEvent::Log::log> function:
366              
367             my $debug_log = AnyEvent::Log::logger "debug";
368              
369             $debug_log->("debug here");
370             $debug_log->("%06d emails processed", 12345);
371             $debug_log->(sub { $obj->as_string });
372              
373             The idea behind this function is to decide whether to log before actually
374             logging - when the C<logger> function is called once, but the returned
375             logger callback often, then this can be a tremendous speed win.
376              
377             Despite this speed advantage, changes in logging configuration will
378             still be reflected by the logger callback, even if configuration changes
379             I<after> it was created.
380              
381             To further speed up logging, you can bind a scalar variable to the logger,
382             which contains true if the logger should be called or not - if it is
383             false, calling the logger can be safely skipped. This variable will be
384             updated as long as C<$logger> is alive.
385              
386             Full example:
387              
388             # near the init section
389             use AnyEvent::Log;
390              
391             my $debug_log = AnyEvent:Log::logger debug => \my $debug;
392              
393             # and later in your program
394             $debug_log->("yo, stuff here") if $debug;
395              
396             $debug and $debug_log->("123");
397              
398             =cut
399              
400             our %LOGGER;
401              
402             # re-assess logging status for all loggers
403             sub _reassess {
404 6     6   85 local $SIG{__DIE__};
405 6     0   15 my $die = sub { die };
  0         0  
406              
407 6 50       24 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
408 0         0 my ($ctx, $level, $renabled) = @$_;
409              
410             # to detect whether a message would be logged, we actually
411             # try to log one and die. this isn't fast, but we can be
412             # sure that the logging decision is correct :)
413              
414 0         0 $$renabled = !eval {
415 0         0 _log $ctx, $level, $die;
416              
417 0         0 1
418             };
419             }
420             }
421              
422             sub _logger {
423 0     0   0 my ($ctx, $level, $renabled) = @_;
424              
425 0         0 $$renabled = 1;
426              
427 0         0 my $logger = [$ctx, $level, $renabled];
428              
429 0         0 $LOGGER{$logger+0} = $logger;
430              
431 0         0 _reassess $logger+0;
432              
433 0 0       0 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
434             my $guard = AnyEvent::Util::guard (sub {
435             # "clean up"
436 0     0   0 delete $LOGGER{$logger+0};
437 0         0 });
438              
439             sub {
440 0     0   0 $guard if 0; # keep guard alive, but don't cause runtime overhead
441              
442 0 0       0 _log $ctx, $level, @_
443             if $$renabled;
444             }
445 0         0 }
446              
447             sub logger($;$) {
448             _logger
449 0   0 0 1 0 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
450             @_
451             }
452              
453             =item AnyEvent::Log::exact_time $on
454              
455             By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
456             eventloop time, for the log timestamps. After calling this function with a
457             true value it will instead resort to C<AE::time>, i.e. fetch the current
458             time on each log message. This only makes a difference for event loops
459             that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
460              
461             This setting can be changed at any time by calling this function.
462              
463             Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
464             initialised, this switch will also decide whether to use C<CORE::time> or
465             C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
466             available.
467              
468             =item AnyEvent::Log::format_time $timestamp
469              
470             Formats a timestamp as returned by C<< AnyEvent->now >> or C<<
471             AnyEvent->time >> or many other functions in the same way as
472             C<AnyEvent::Log> does.
473              
474             In your main program (as opposed to in your module) you can override
475             the default timestamp display format by loading this module and then
476             redefining this function.
477              
478             Most commonly, this function can be used in formatting callbacks.
479              
480             =item AnyEvent::Log::default_format $time, $ctx, $level, $msg
481              
482             Format a log message using the given timestamp, logging context, log level
483             and log message.
484              
485             This is the formatting function used to format messages when no custom
486             function is provided.
487              
488             In your main program (as opposed to in your module) you can override the
489             default message format by loading this module and then redefining this
490             function.
491              
492             =item AnyEvent::Log::fatal_exit()
493              
494             This is the function that is called after logging a C<fatal> log
495             message. It must not return.
496              
497             The default implementation simply calls C<exit 1>.
498              
499             In your main program (as opposed to in your module) you can override
500             the fatal exit function by loading this module and then redefining this
501             function. Make sure you don't return.
502              
503             =back
504              
505             =head1 LOGGING CONTEXTS
506              
507             This module associates every log message with a so-called I<logging
508             context>, based on the package of the caller. Every perl package has its
509             own logging context.
510              
511             A logging context has three major responsibilities: filtering, logging and
512             propagating the message.
513              
514             For the first purpose, filtering, each context has a set of logging
515             levels, called the log level mask. Messages not in the set will be ignored
516             by this context (masked).
517              
518             For logging, the context stores a formatting callback (which takes the
519             timestamp, context, level and string message and formats it in the way
520             it should be logged) and a logging callback (which is responsible for
521             actually logging the formatted message and telling C<AnyEvent::Log>
522             whether it has consumed the message, or whether it should be propagated).
523              
524             For propagation, a context can have any number of attached I<slave
525             contexts>. Any message that is neither masked by the logging mask nor
526             masked by the logging callback returning true will be passed to all slave
527             contexts.
528              
529             Each call to a logging function will log the message at most once per
530             context, so it does not matter (much) if there are cycles or if the
531             message can arrive at the same context via multiple paths.
532              
533             =head2 DEFAULTS
534              
535             By default, all logging contexts have an full set of log levels ("all"), a
536             disabled logging callback and the default formatting callback.
537              
538             Package contexts have the package name as logging title by default.
539              
540             They have exactly one slave - the context of the "parent" package. The
541             parent package is simply defined to be the package name without the last
542             component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
543             and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
544             exception of the rule - just like the "parent" of any single-component
545             package name in Perl is C<main>, the default slave of any top-level
546             package context is C<$AnyEvent::Log::COLLECT>.
547              
548             Since perl packages form only an approximate hierarchy, this slave
549             context can of course be removed.
550              
551             All other (anonymous) contexts have no slaves and an empty title by
552             default.
553              
554             When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
555             context that simply logs everything via C<warn>, without propagating
556             anything anywhere by default. The purpose of this context is to provide
557             a convenient place to override the global logging target or to attach
558             additional log targets. It's not meant for filtering.
559              
560             It then creates the C<$AnyEvent::Log::FILTER> context whose
561             purpose is to suppress all messages with priority higher
562             than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
563             C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
564             is to simply provide filtering according to some global log level.
565              
566             Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
567             and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
568             leaves it at default config. Its purpose is simply to collect all log
569             messages system-wide.
570              
571             The hierarchy is then:
572              
573             any package, eventually -> $COLLECT -> $FILTER -> $LOG
574              
575             The effect of all this is that log messages, by default, wander up to the
576             C<$AnyEvent::Log::COLLECT> context where all messages normally end up,
577             from there to C<$AnyEvent::Log::FILTER> where log messages with lower
578             priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
579             to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
580              
581             This makes it easy to set a global logging level (by modifying $FILTER),
582             but still allow other contexts to send, for example, their debug and trace
583             messages to the $LOG target despite the global logging level, or to attach
584             additional log targets that log messages, regardless of the global logging
585             level.
586              
587             It also makes it easy to modify the default warn-logger ($LOG) to
588             something that logs to a file, or to attach additional logging targets
589             (such as loggign to a file) by attaching it to $FILTER.
590              
591             =head2 CREATING/FINDING/DESTROYING CONTEXTS
592              
593             =over 4
594              
595             =item $ctx = AnyEvent::Log::ctx [$pkg]
596              
597             This function creates or returns a logging context (which is an object).
598              
599             If a package name is given, then the context for that package is
600             returned. If it is called without any arguments, then the context for the
601             callers package is returned (i.e. the same context as a C<AE::log> call
602             would use).
603              
604             If C<undef> is given, then it creates a new anonymous context that is not
605             tied to any package and is destroyed when no longer referenced.
606              
607             =cut
608              
609             sub ctx(;$) {
610 5 50   5 1 10 my $pkg = @_ ? shift : (caller)[0];
611              
612             ref $pkg
613             ? $pkg
614             : defined $pkg
615 5 50 0     22 ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg
    100          
616             : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
617             }
618              
619             =item AnyEvent::Log::reset
620              
621             Resets all package contexts and recreates the default hierarchy if
622             necessary, i.e. resets the logging subsystem to defaults, as much as
623             possible. This process keeps references to contexts held by other parts of
624             the program intact.
625              
626             This can be used to implement config-file (re-)loading: before loading a
627             configuration, reset all contexts.
628              
629             =cut
630              
631             our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
632             $AnyEvent::VERBOSE = 9;
633              
634             sub reset {
635             # hard to kill complex data structures
636             # we "recreate" all package loggers and reset the hierarchy
637 1     1 1 4 while (my ($k, $v) = each %CTX) {
638 0         0 @$v = ($k, (1 << 10) - 1 - 1, { });
639              
640 0 0       0 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
641             }
642              
643             @$_ = ($_->[0], (1 << 10) - 1 - 1)
644 1         10 for $LOG, $FILTER, $COLLECT;
645              
646             #$LOG->slaves;
647 1         4 $LOG->title ('$AnyEvent::Log::LOG');
648 1         2 $LOG->log_to_warn;
649              
650 1         3 $FILTER->slaves ($LOG);
651 1         3 $FILTER->title ('$AnyEvent::Log::FILTER');
652 1         3 $FILTER->level ($ORIG_VERBOSE);
653              
654 1         3 $COLLECT->slaves ($FILTER);
655 1         4 $COLLECT->title ('$AnyEvent::Log::COLLECT');
656              
657 1         2 _reassess;
658             }
659              
660             # override AE::log/logger
661             *AnyEvent::log = *AE::log = \&log;
662             *AnyEvent::logger = *AE::logger = \&logger;
663              
664             # convert AnyEvent loggers to AnyEvent::Log loggers
665             $_->[0] = ctx $_->[0] # convert "pkg" to "ctx"
666             for values %LOGGER;
667              
668             # create the default logger contexts
669             $LOG = ctx undef;
670             $FILTER = ctx undef;
671             $COLLECT = ctx undef;
672              
673             AnyEvent::Log::reset;
674              
675             # hello, CPAN, please catch me
676             package AnyEvent::Log::LOG;
677             package AE::Log::LOG;
678             package AnyEvent::Log::FILTER;
679             package AE::Log::FILTER;
680             package AnyEvent::Log::COLLECT;
681             package AE::Log::COLLECT;
682              
683             package AnyEvent::Log::Ctx;
684              
685             =item $ctx = new AnyEvent::Log::Ctx methodname => param...
686              
687             This is a convenience constructor that makes it simpler to construct
688             anonymous logging contexts.
689              
690             Each key-value pair results in an invocation of the method of the same
691             name as the key with the value as parameter, unless the value is an
692             arrayref, in which case it calls the method with the contents of the
693             array. The methods are called in the same order as specified.
694              
695             Example: create a new logging context and set both the default logging
696             level, some slave contexts and a logging callback.
697              
698             $ctx = new AnyEvent::Log::Ctx
699             title => "dubious messages",
700             level => "error",
701             log_cb => sub { print STDOUT shift; 0 },
702             slaves => [$ctx1, $ctx, $ctx2],
703             ;
704              
705             =back
706              
707             =cut
708              
709             sub new {
710 0     0   0 my $class = shift;
711              
712 0         0 my $ctx = AnyEvent::Log::ctx undef;
713              
714 0         0 while (@_) {
715 0         0 my ($k, $v) = splice @_, 0, 2;
716 0 0       0 $ctx->$k (ref $v eq "ARRAY" ? @$v : $v);
717             }
718              
719 0         0 bless $ctx, $class # do we really support subclassing, hmm?
720             }
721              
722              
723             =head2 CONFIGURING A LOG CONTEXT
724              
725             The following methods can be used to configure the logging context.
726              
727             =over 4
728              
729             =item $ctx->title ([$new_title])
730              
731             Returns the title of the logging context - this is the package name, for
732             package contexts, and a user defined string for all others.
733              
734             If C<$new_title> is given, then it replaces the package name or title.
735              
736             =cut
737              
738             sub title {
739 3 50   3   7 $_[0][0] = $_[1] if @_ > 1;
740 3         4 $_[0][0]
741             }
742              
743             =back
744              
745             =head3 LOGGING LEVELS
746              
747             The following methods deal with the logging level set associated with the
748             log context.
749              
750             The most common method to use is probably C<< $ctx->level ($level) >>,
751             which configures the specified and any higher priority levels.
752              
753             All functions which accept a list of levels also accept the special string
754             C<all> which expands to all logging levels.
755              
756             =over 4
757              
758             =item $ctx->levels ($level[, $level...)
759              
760             Enables logging for the given levels and disables it for all others.
761              
762             =item $ctx->level ($level)
763              
764             Enables logging for the given level and all lower level (higher priority)
765             ones. In addition to normal logging levels, specifying a level of C<0> or
766             C<off> disables all logging for this level.
767              
768             Example: log warnings, errors and higher priority messages.
769              
770             $ctx->level ("warn");
771             $ctx->level (5); # same thing, just numeric
772              
773             =item $ctx->enable ($level[, $level...])
774              
775             Enables logging for the given levels, leaving all others unchanged.
776              
777             =item $ctx->disable ($level[, $level...])
778              
779             Disables logging for the given levels, leaving all others unchanged.
780              
781             =item $ctx->cap ($level)
782              
783             Caps the maximum priority to the given level, for all messages logged
784             to, or passing through, this context. That is, while this doesn't affect
785             whether a message is logged or passed on, the maximum priority of messages
786             will be limited to the specified level - messages with a higher priority
787             will be set to the specified priority.
788              
789             Another way to view this is that C<< ->level >> filters out messages with
790             a too low priority, while C<< ->cap >> modifies messages with a too high
791             priority.
792              
793             This is useful when different log targets have different interpretations
794             of priority. For example, for a specific command line program, a wrong
795             command line switch might well result in a C<fatal> log message, while the
796             same message, logged to syslog, is likely I<not> fatal to the system or
797             syslog facility as a whole, but more likely a mere C<error>.
798              
799             This can be modeled by having a stderr logger that logs messages "as-is"
800             and a syslog logger that logs messages with a level cap of, say, C<error>,
801             or, for truly system-critical components, actually C<critical>.
802              
803             =cut
804              
805             sub _lvl_lst {
806             map {
807 1     1   2 $_ > 0 && $_ <= 9 ? $_+0
808             : $_ eq "all" ? (1 .. 9)
809 1 0 33     8 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
    50 0        
810             } @_
811             }
812              
813             sub _lvl {
814 1 50   1   5 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
815             }
816              
817             our $NOP_CB = sub { 0 };
818              
819             sub levels {
820 0     0   0 my $ctx = shift;
821 0         0 $ctx->[1] = 0;
822             $ctx->[1] |= 1 << $_
823 0         0 for &_lvl_lst;
824 0         0 AnyEvent::Log::_reassess;
825             }
826              
827             sub level {
828 1     1   1 my $ctx = shift;
829 1         2 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
830 1         2 AnyEvent::Log::_reassess;
831             }
832              
833             sub enable {
834 0     0   0 my $ctx = shift;
835             $ctx->[1] |= 1 << $_
836 0         0 for &_lvl_lst;
837 0         0 AnyEvent::Log::_reassess;
838             }
839              
840             sub disable {
841 0     0   0 my $ctx = shift;
842             $ctx->[1] &= ~(1 << $_)
843 0         0 for &_lvl_lst;
844 0         0 AnyEvent::Log::_reassess;
845             }
846              
847             sub cap {
848 0     0   0 my $ctx = shift;
849 0         0 $ctx->[5] = &_lvl;
850             }
851              
852             =back
853              
854             =head3 SLAVE CONTEXTS
855              
856             The following methods attach and detach another logging context to a
857             logging context.
858              
859             Log messages are propagated to all slave contexts, unless the logging
860             callback consumes the message.
861              
862             =over 4
863              
864             =item $ctx->attach ($ctx2[, $ctx3...])
865              
866             Attaches the given contexts as slaves to this context. It is not an error
867             to add a context twice (the second add will be ignored).
868              
869             A context can be specified either as package name or as a context object.
870              
871             =item $ctx->detach ($ctx2[, $ctx3...])
872              
873             Removes the given slaves from this context - it's not an error to attempt
874             to remove a context that hasn't been added.
875              
876             A context can be specified either as package name or as a context object.
877              
878             =item $ctx->slaves ($ctx2[, $ctx3...])
879              
880             Replaces all slaves attached to this context by the ones given.
881              
882             =cut
883              
884             sub attach {
885 2     2   30 my $ctx = shift;
886              
887             $ctx->[2]{$_+0} = $_
888 2         77 for map { AnyEvent::Log::ctx $_ } @_;
  2         6  
889 2         4 AnyEvent::Log::_reassess;
890             }
891              
892             sub detach {
893 0     0   0 my $ctx = shift;
894              
895             delete $ctx->[2]{$_+0}
896 0         0 for map { AnyEvent::Log::ctx $_ } @_;
  0         0  
897 0         0 AnyEvent::Log::_reassess;
898             }
899              
900             sub slaves {
901 2     2   3 undef $_[0][2];
902 2         4 &attach;
903 2         4 AnyEvent::Log::_reassess;
904             }
905              
906             =back
907              
908             =head3 LOG TARGETS
909              
910             The following methods configure how the logging context actually does
911             the logging (which consists of formatting the message and printing it or
912             whatever it wants to do with it).
913              
914             =over 4
915              
916             =item $ctx->log_cb ($cb->($str))
917              
918             Replaces the logging callback on the context (C<undef> disables the
919             logging callback).
920              
921             The logging callback is responsible for handling formatted log messages
922             (see C<fmt_cb> below) - normally simple text strings that end with a
923             newline (and are possibly multiline themselves).
924              
925             It also has to return true iff it has consumed the log message, and false
926             if it hasn't. Consuming a message means that it will not be sent to any
927             slave context. When in doubt, return C<0> from your logging callback.
928              
929             Example: a very simple logging callback, simply dump the message to STDOUT
930             and do not consume it.
931              
932             $ctx->log_cb (sub { print STDERR shift; 0 });
933              
934             You can filter messages by having a log callback that simply returns C<1>
935             and does not do anything with the message, but this counts as "message
936             being logged" and might not be very efficient.
937              
938             Example: propagate all messages except for log levels "debug" and
939             "trace". The messages will still be generated, though, which can slow down
940             your program.
941              
942             $ctx->levels ("debug", "trace");
943             $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
944              
945             =item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
946              
947             Replaces the formatting callback on the context (C<undef> restores the
948             default formatter).
949              
950             The callback is passed the (possibly fractional) timestamp, the original
951             logging context (object, not title), the (numeric) logging level and
952             the raw message string and needs to return a formatted log message. In
953             most cases this will be a string, but it could just as well be an array
954             reference that just stores the values.
955              
956             If, for some reason, you want to use C<caller> to find out more about the
957             logger then you should walk up the call stack until you are no longer
958             inside the C<AnyEvent::Log> package.
959              
960             To implement your own logging callback, you might find the
961             C<AnyEvent::Log::format_time> and C<AnyEvent::Log::default_format>
962             functions useful.
963              
964             Example: format the message just as AnyEvent::Log would, by letting
965             AnyEvent::Log do the work. This is a good basis to design a formatting
966             callback that only changes minor aspects of the formatting.
967              
968             $ctx->fmt_cb (sub {
969             my ($time, $ctx, $lvl, $msg) = @_;
970              
971             AnyEvent::Log::default_format $time, $ctx, $lvl, $msg
972             });
973              
974             Example: format just the raw message, with numeric log level in angle
975             brackets.
976              
977             $ctx->fmt_cb (sub {
978             my ($time, $ctx, $lvl, $msg) = @_;
979              
980             "<$lvl>$msg\n"
981             });
982              
983             Example: return an array reference with just the log values, and use
984             C<PApp::SQL::sql_exec> to store the message in a database.
985              
986             $ctx->fmt_cb (sub { \@_ });
987             $ctx->log_cb (sub {
988             my ($msg) = @_;
989              
990             sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)",
991             $msg->[0] + 0,
992             "$msg->[1]",
993             $msg->[2] + 0,
994             "$msg->[3]";
995              
996             0
997             });
998              
999             =item $ctx->log_to_warn
1000              
1001             Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
1002             (usually this logs to STDERR).
1003              
1004             =item $ctx->log_to_file ($path)
1005              
1006             Sets the C<log_cb> to log to a file (by appending), unbuffered. The
1007             function might return before the log file has been opened or created.
1008              
1009             =item $ctx->log_to_path ($path)
1010              
1011             Same as C<< ->log_to_file >>, but opens the file for each message. This
1012             is much slower, but allows you to change/move/rename/delete the file at
1013             basically any time.
1014              
1015             Needless(?) to say, if you do not want to be bitten by some evil person
1016             calling C<chdir>, the path should be absolute. Doesn't help with
1017             C<chroot>, but hey...
1018              
1019             =item $ctx->log_to_syslog ([$facility])
1020              
1021             Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
1022             all the others in the obvious way. If specified, then the C<$facility> is
1023             used as the facility (C<user>, C<auth>, C<local0> and so on). The default
1024             facility is C<user>.
1025              
1026             Note that this function also sets a C<fmt_cb> - the logging part requires
1027             an array reference with [$level, $str] as input.
1028              
1029             =cut
1030              
1031             sub log_cb {
1032 1     1   2 my ($ctx, $cb) = @_;
1033              
1034 1         2 $ctx->[3] = $cb;
1035             }
1036              
1037             sub fmt_cb {
1038 0     0   0 my ($ctx, $cb) = @_;
1039              
1040 0         0 $ctx->[4] = $cb;
1041             }
1042              
1043             sub log_to_warn {
1044 1     1   2 my ($ctx, $path) = @_;
1045              
1046             $ctx->log_cb (sub {
1047 0     0     warn shift;
1048 0           0
1049 1         4 });
1050             }
1051              
1052             # this function is a good example of why threads are a must,
1053             # simply for priority inversion.
1054             sub _log_to_disk {
1055             # eval'uating this at runtime saves 220kb rss - perl has become
1056             # an insane memory waster.
1057 0     0     eval q{ # poor man's autoloading {}
1058             sub _log_to_disk {
1059             my ($ctx, $path, $keepopen) = @_;
1060              
1061             my $fh;
1062             my @queue;
1063             my $delay;
1064             my $disable;
1065              
1066             use AnyEvent::IO ();
1067              
1068             my $kick = sub {
1069             undef $delay;
1070             return unless @queue;
1071             $delay = 1;
1072              
1073             # we pass $kick to $kick, so $kick itself doesn't keep a reference to $kick.
1074             my $kick = shift;
1075              
1076             # write one or more messages
1077             my $write = sub {
1078             # we write as many messages as have been queued
1079             my $data = join "", @queue;
1080             @queue = ();
1081              
1082             AnyEvent::IO::aio_write $fh, $data, sub {
1083             $disable = 1;
1084             @_
1085             ? ($_[0] == length $data or AE::log 4 => "unable to write to logfile '$path': short write")
1086             : AE::log 4 => "unable to write to logfile '$path': $!";
1087             undef $disable;
1088              
1089             if ($keepopen) {
1090             $kick->($kick);
1091             } else {
1092             AnyEvent::IO::aio_close ($fh, sub {
1093             undef $fh;
1094             $kick->($kick);
1095             });
1096             }
1097             };
1098             };
1099              
1100             if ($fh) {
1101             $write->();
1102             } else {
1103             AnyEvent::IO::aio_open
1104             $path,
1105             AnyEvent::IO::O_CREAT | AnyEvent::IO::O_WRONLY | AnyEvent::IO::O_APPEND,
1106             0666,
1107             sub {
1108             $fh = shift
1109             or do {
1110             $disable = 1;
1111             AE::log 4 => "unable to open logfile '$path': $!";
1112             undef $disable;
1113             return;
1114             };
1115              
1116             $write->();
1117             }
1118             ;
1119             }
1120             };
1121              
1122             $ctx->log_cb (sub {
1123             return if $disable;
1124             push @queue, shift;
1125             $kick->($kick) unless $delay;
1126             0
1127             });
1128              
1129             $kick->($kick) if $keepopen; # initial open
1130             };
1131             };
1132 0 0         die if $@;
1133 0           &_log_to_disk
1134             }
1135              
1136             sub log_to_file {
1137 0     0     my ($ctx, $path) = @_;
1138              
1139 0           _log_to_disk $ctx, $path, 1;
1140             }
1141              
1142             sub log_to_path {
1143 0     0     my ($ctx, $path) = @_;
1144              
1145 0           _log_to_disk $ctx, $path, 0;
1146             }
1147              
1148             sub log_to_syslog {
1149 0     0     my ($ctx, $facility) = @_;
1150              
1151 0           require Sys::Syslog;
1152              
1153             $ctx->fmt_cb (sub {
1154 0     0     my $str = $_[3];
1155 0           $str =~ s/\n(?=.)/\n+ /g;
1156              
1157 0           [$_[2], "($_[1][0]) $str"]
1158 0           });
1159              
1160 0   0       $facility ||= "user";
1161              
1162             $ctx->log_cb (sub {
1163 0 0   0     my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
1164              
1165             Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
1166 0           for split /\n/, $_[0][1];
1167              
1168 0           0
1169 0           });
1170             }
1171              
1172             =back
1173              
1174             =head3 MESSAGE LOGGING
1175              
1176             These methods allow you to log messages directly to a context, without
1177             going via your package context.
1178              
1179             =over 4
1180              
1181             =item $ctx->log ($level, $msg[, @params])
1182              
1183             Same as C<AnyEvent::Log::log>, but uses the given context as log context.
1184              
1185             Example: log a message in the context of another package.
1186              
1187             (AnyEvent::Log::ctx "Other::Package")->log (warn => "heely bo");
1188              
1189             =item $logger = $ctx->logger ($level[, \$enabled])
1190              
1191             Same as C<AnyEvent::Log::logger>, but uses the given context as log
1192             context.
1193              
1194             =cut
1195              
1196             *log = \&AnyEvent::Log::_log;
1197             *logger = \&AnyEvent::Log::_logger;
1198              
1199             =back
1200              
1201             =cut
1202              
1203             package AnyEvent::Log;
1204              
1205             =head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
1206              
1207             Logging can also be configured by setting the environment variable
1208             C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
1209              
1210             The value consists of one or more logging context specifications separated
1211             by C<:> or whitespace. Each logging specification in turn starts with a
1212             context name, followed by C<=>, followed by zero or more comma-separated
1213             configuration directives, here are some examples:
1214              
1215             # set default logging level
1216             filter=warn
1217              
1218             # log to file instead of to stderr
1219             log=file=/tmp/mylog
1220              
1221             # log to file in addition to stderr
1222             log=+%file:%file=file=/tmp/mylog
1223              
1224             # enable debug log messages, log warnings and above to syslog
1225             filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
1226              
1227             # log trace messages (only) from AnyEvent::Debug to file
1228             AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
1229              
1230             A context name in the log specification can be any of the following:
1231              
1232             =over 4
1233              
1234             =item C<collect>, C<filter>, C<log>
1235              
1236             Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
1237             C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
1238              
1239             =item C<%name>
1240              
1241             Context names starting with a C<%> are anonymous contexts created when the
1242             name is first mentioned. The difference to package contexts is that by
1243             default they have no attached slaves.
1244              
1245             This makes it possible to create new log contexts that can be refered to
1246             multiple times by name within the same log specification.
1247              
1248             =item a perl package name
1249              
1250             Any other string references the logging context associated with the given
1251             Perl C<package>. In the unlikely case where you want to specify a package
1252             context that matches on of the other context name forms, you can add a
1253             C<::> to the package name to force interpretation as a package.
1254              
1255             =back
1256              
1257             The configuration specifications can be any number of the following:
1258              
1259             =over 4
1260              
1261             =item C<stderr>
1262              
1263             Configures the context to use Perl's C<warn> function (which typically
1264             logs to C<STDERR>). Works like C<log_to_warn>.
1265              
1266             =item C<file=>I<path>
1267              
1268             Configures the context to log to a file with the given path. Works like
1269             C<log_to_file>.
1270              
1271             =item C<path=>I<path>
1272              
1273             Configures the context to log to a file with the given path. Works like
1274             C<log_to_path>.
1275              
1276             =item C<syslog> or C<syslog=>I<expr>
1277              
1278             Configures the context to log to syslog. If I<expr> is given, then it is
1279             evaluated in the L<Sys::Syslog> package, so you could use:
1280              
1281             log=syslog=LOG_LOCAL0
1282              
1283             =item C<nolog>
1284              
1285             Configures the context to not log anything by itself, which is the
1286             default. Same as C<< $ctx->log_cb (undef) >>.
1287              
1288             =item C<cap=>I<level>
1289              
1290             Caps logging messages entering this context at the given level, i.e.
1291             reduces the priority of messages with higher priority than this level. The
1292             default is C<0> (or C<off>), meaning the priority will not be touched.
1293              
1294             =item C<0> or C<off>
1295              
1296             Sets the logging level of the context to C<0>, i.e. all messages will be
1297             filtered out.
1298              
1299             =item C<all>
1300              
1301             Enables all logging levels, i.e. filtering will effectively be switched
1302             off (the default).
1303              
1304             =item C<only>
1305              
1306             Disables all logging levels, and changes the interpretation of following
1307             level specifications to enable the specified level only.
1308              
1309             Example: only enable debug messages for a context.
1310              
1311             context=only,debug
1312              
1313             =item C<except>
1314              
1315             Enables all logging levels, and changes the interpretation of following
1316             level specifications to disable that level. Rarely used.
1317              
1318             Example: enable all logging levels except fatal and trace (this is rather
1319             nonsensical).
1320              
1321             filter=exept,fatal,trace
1322              
1323             =item C<level>
1324              
1325             Enables all logging levels, and changes the interpretation of following
1326             level specifications to be "that level or any higher priority
1327             message". This is the default.
1328              
1329             Example: log anything at or above warn level.
1330              
1331             filter=warn
1332              
1333             # or, more verbose
1334             filter=only,level,warn
1335              
1336             =item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
1337              
1338             A numeric loglevel or the name of a loglevel will be interpreted according
1339             to the most recent C<only>, C<except> or C<level> directive. By default,
1340             specifying a logging level enables that and any higher priority messages.
1341              
1342             =item C<+>I<context>
1343              
1344             Attaches the named context as slave to the context.
1345              
1346             =item C<+>
1347              
1348             A lone C<+> detaches all contexts, i.e. clears the slave list from the
1349             context. Anonymous (C<%name>) contexts have no attached slaves by default,
1350             but package contexts have the parent context as slave by default.
1351              
1352             Example: log messages from My::Module to a file, do not send them to the
1353             default log collector.
1354              
1355             My::Module=+,file=/tmp/mymodulelog
1356              
1357             =back
1358              
1359             Any character can be escaped by prefixing it with a C<\> (backslash), as
1360             usual, so to log to a file containing a comma, colon, backslash and some
1361             spaces in the filename, you would do this:
1362              
1363             PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
1364              
1365             Since whitespace (which includes newlines) is allowed, it is fine to
1366             specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
1367              
1368             PERL_ANYEVENT_LOG="
1369             filter=warn
1370             AnyEvent::Debug=+%trace
1371             %trace=only,trace,+log
1372             " myprog
1373              
1374             Also, in the unlikely case when you want to concatenate specifications,
1375             use whitespace as separator, as C<::> will be interpreted as part of a
1376             module name, an empty spec with two separators:
1377              
1378             PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
1379              
1380             =cut
1381              
1382             for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1383             my %anon;
1384              
1385             my $pkg = sub {
1386             $_[0] eq "log" ? $LOG
1387             : $_[0] eq "filter" ? $FILTER
1388             : $_[0] eq "collect" ? $COLLECT
1389             : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1390             : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1391             : die # never reached?
1392             };
1393              
1394             /\G[[:space:]]+/gc; # skip initial whitespace
1395              
1396             while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
1397             my $ctx = $pkg->($1);
1398             my $level = "level";
1399              
1400             while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1401             for ("$1") {
1402             if ($_ eq "stderr" ) { $ctx->log_to_warn;
1403             } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1404             } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1405             } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1406             } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1407             } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1408             } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1409             } elsif ($_ eq "+" ) { $ctx->slaves;
1410             } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1411             } elsif ($_ eq "all" ) { $ctx->level ("all");
1412             } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1413             } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
1414             } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
1415             } elsif (/^\d$/ ) { $ctx->$level ($_);
1416             } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
1417             } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
1418             }
1419             }
1420              
1421             /\G,/gc or last;
1422             }
1423              
1424             /\G[:[:space:]]+/gc or last;
1425             }
1426              
1427             /\G[[:space:]]+/gc; # skip trailing whitespace
1428              
1429             if (/\G(.+)/g) {
1430             die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1431             }
1432             }
1433              
1434             =head1 EXAMPLES
1435              
1436             This section shows some common configurations, both as code, and as
1437             C<PERL_ANYEVENT_LOG> string.
1438              
1439             =over 4
1440              
1441             =item Setting the global logging level.
1442              
1443             Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
1444             running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
1445             the root context at runtime:
1446              
1447             PERL_ANYEVENT_VERBOSE=5 ./myprog
1448              
1449             PERL_ANYEVENT_LOG=log=warn
1450              
1451             $AnyEvent::Log::FILTER->level ("warn");
1452              
1453             =item Append all messages to a file instead of sending them to STDERR.
1454              
1455             This is affected by the global logging level.
1456              
1457             $AnyEvent::Log::LOG->log_to_file ($path);
1458              
1459             PERL_ANYEVENT_LOG=log=file=/some/path
1460              
1461             =item Write all messages with priority C<error> and higher to a file.
1462              
1463             This writes them only when the global logging level allows it, because
1464             it is attached to the default context which is invoked I<after> global
1465             filtering.
1466              
1467             $AnyEvent::Log::FILTER->attach (
1468             new AnyEvent::Log::Ctx log_to_file => $path);
1469              
1470             PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
1471              
1472             This writes them regardless of the global logging level, because it is
1473             attached to the toplevel context, which receives all messages I<before>
1474             the global filtering.
1475              
1476             $AnyEvent::Log::COLLECT->attach (
1477             new AnyEvent::Log::Ctx log_to_file => $path);
1478              
1479             PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1480              
1481             In both cases, messages are still written to STDERR.
1482              
1483             =item Additionally log all messages with C<warn> and higher priority to
1484             C<syslog>, but cap at C<error>.
1485              
1486             This logs all messages to the default log target, but also logs messages
1487             with priority C<warn> or higher (and not filtered otherwise) to syslog
1488             facility C<user>. Messages with priority higher than C<error> will be
1489             logged with level C<error>.
1490              
1491             $AnyEvent::Log::LOG->attach (
1492             new AnyEvent::Log::Ctx
1493             level => "warn",
1494             cap => "error",
1495             syslog => "user",
1496             );
1497              
1498             PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog
1499              
1500             =item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
1501              
1502             Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
1503             context - this simply circumvents the global filtering for trace messages.
1504              
1505             my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
1506             $debug->attach ($AnyEvent::Log::LOG);
1507              
1508             PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
1509              
1510             This of course works for any package, not just L<AnyEvent::Debug>, but
1511             assumes the log level for AnyEvent::Debug hasn't been changed from the
1512             default.
1513              
1514             =back
1515              
1516             =head1 ASYNCHRONOUS DISK I/O
1517              
1518             This module uses L<AnyEvent::IO> to actually write log messages (in
1519             C<log_to_file> and C<log_to_path>), so it doesn't block your program when
1520             the disk is busy and a non-blocking L<AnyEvent::IO> backend is available.
1521              
1522             =head1 AUTHOR
1523              
1524             Marc Lehmann <schmorp@schmorp.de>
1525             http://anyevent.schmorp.de
1526              
1527             =cut
1528              
1529             1
1530