ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Log.pm
Revision: 1.22
Committed: Sun Aug 21 02:19:30 2011 UTC (12 years, 10 months ago) by root
Branch: MAIN
Changes since 1.21: +12 -4 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 =head1 NAME
2    
3     AnyEvent::Log - simple logging "framework"
4    
5     =head1 SYNOPSIS
6    
7 root 1.8 # simple use
8     use AnyEvent;
9    
10     AE::log debug => "hit my knee";
11     AE::log warn => "it's a bit too hot";
12     AE::log error => "the flag was false!";
13     AE::log fatal => "the bit toggled! run!";
14    
15 root 1.10 # "complex" use
16 root 1.1 use AnyEvent::Log;
17    
18 root 1.8 my $tracer = AnyEvent::Log::logger trace => \$my $trace;
19    
20     $tracer->("i am here") if $trace;
21     $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
22    
23 root 1.10 # configuration
24    
25 root 1.18 # set logging for the current package to errors and higher only
26 root 1.16 AnyEvent::Log::ctx->level ("error");
27 root 1.10
28     # set logging globally to anything below debug
29 root 1.18 $AnyEvent::Log::FILTER->level ("notice");
30 root 1.10
31     # see also EXAMPLES, below
32    
33 root 1.1 =head1 DESCRIPTION
34    
35 root 1.2 This module implements a relatively simple "logging framework". It doesn't
36     attempt to be "the" logging solution or even "a" logging solution for
37     AnyEvent - AnyEvent simply creates logging messages internally, and this
38     module more or less exposes the mechanism, with some extra spiff to allow
39     using it from other modules as well.
40    
41 root 1.20 Remember that the default verbosity level is C<0> (C<off>), so nothing
42     will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
43     before starting your program, or change the logging level at runtime with
44 root 1.9 something like:
45 root 1.2
46 root 1.18 use AnyEvent::Log;
47     AnyEvent::Log::FILTER->level ("info");
48 root 1.2
49 root 1.10 The design goal behind this module was to keep it simple (and small),
50     but make it powerful enough to be potentially useful for any module, and
51     extensive enough for the most common tasks, such as logging to multiple
52     targets, or being able to log into a database.
53    
54 root 1.14 The amount of documentation might indicate otherwise, but the module is
55 root 1.18 still just below 300 lines of code.
56    
57     =head1 LOGGING LEVELS
58    
59     Logging levels in this module range from C<1> (highest priority) to C<9>
60     (lowest priority). Note that the lowest numerical value is the highest
61     priority, so when this document says "higher priority" it means "lower
62     numerical value".
63    
64     Instead of specifying levels by name you can also specify them by aliases:
65    
66     LVL NAME SYSLOG PERL NOTE
67     1 fatal emerg exit aborts program!
68     2 alert
69     3 critical crit
70     4 error err die
71     5 warn warning
72     6 note notice
73     7 info
74     8 debug
75     9 trace
76    
77     As you can see, some logging levels have multiple aliases - the first one
78     is the "official" name, the second one the "syslog" name (if it differs)
79     and the third one the "perl" name, suggesting that you log C<die> messages
80     at C<error> priority.
81    
82     You can normally only log a single message at highest priority level
83     (C<1>, C<fatal>), because logging a fatal message will also quit the
84     program - so use it sparingly :)
85    
86     Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
87     or C<all> - these are only valid in the methods they are documented for.
88 root 1.14
89 root 1.9 =head1 LOGGING FUNCTIONS
90 root 1.2
91     These functions allow you to log messages. They always use the caller's
92 root 1.18 package as a "logging context". Also, the main logging function C<log> is
93 root 1.7 callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
94     loaded.
95 root 1.1
96     =over 4
97    
98     =cut
99    
100     package AnyEvent::Log;
101    
102 root 1.2 use Carp ();
103 root 1.1 use POSIX ();
104    
105     use AnyEvent (); BEGIN { AnyEvent::common_sense }
106 root 1.3 use AnyEvent::Util ();
107 root 1.1
108 root 1.14 our $VERSION = $AnyEvent::VERSION;
109    
110 root 1.18 our ($COLLECT, $FILTER, $LOG);
111    
112 root 1.2 our ($now_int, $now_str1, $now_str2);
113    
114     # Format Time, not public - yet?
115     sub ft($) {
116     my $i = int $_[0];
117     my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
118    
119     ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
120     if $now_int != $i;
121    
122     "$now_str1$f$now_str2"
123     }
124    
125 root 1.18 our %CTX; # all package contexts
126 root 1.3
127 root 1.8 # creates a default package context object for the given package
128     sub _pkg_ctx($) {
129 root 1.10 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
130 root 1.8
131     # link "parent" package
132 root 1.18 my $parent = $_[0] =~ /^(.+)::/
133     ? $CTX{$1} ||= &_pkg_ctx ("$1")
134     : $COLLECT;
135 root 1.8
136 root 1.18 $ctx->[2]{$parent+0} = $parent;
137 root 1.8
138     $ctx
139     }
140    
141 root 1.2 =item AnyEvent::Log::log $level, $msg[, @args]
142    
143 root 1.22 Requests logging of the given C<$msg> with the given log level, and
144     returns true if the message was logged I<somewhere>.
145 root 1.2
146     For C<fatal> log levels, the program will abort.
147    
148     If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
149     C<$msg> is interpreted as an sprintf format string.
150    
151     The C<$msg> should not end with C<\n>, but may if that is convenient for
152     you. Also, multiline messages are handled properly.
153    
154 root 1.3 Last not least, C<$msg> might be a code reference, in which case it is
155     supposed to return the message. It will be called only then the message
156     actually gets logged, which is useful if it is costly to create the
157     message in the first place.
158 root 1.2
159     Whether the given message will be logged depends on the maximum log level
160 root 1.22 and the caller's package. The return value can be used to ensure that
161     messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
162     runtime error it tries to log it at C<die> level, but if that message is
163     lost it simply uses warn.
164 root 1.2
165     Note that you can (and should) call this function as C<AnyEvent::log> or
166 root 1.8 C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
167     need any additional functionality), as those functions will load the
168     logging module on demand only. They are also much shorter to write.
169    
170 root 1.11 Also, if you optionally generate a lot of debug messages (such as when
171 root 1.8 tracing some code), you should look into using a logger callback and a
172     boolean enabler (see C<logger>, below).
173 root 1.2
174 root 1.3 Example: log something at error level.
175    
176     AE::log error => "something";
177    
178     Example: use printf-formatting.
179    
180     AE::log info => "%5d %-10.10s %s", $index, $category, $msg;
181    
182     Example: only generate a costly dump when the message is actually being logged.
183    
184     AE::log debug => sub { require Data::Dump; Data::Dump::dump \%cache };
185    
186 root 1.2 =cut
187    
188     # also allow syslog equivalent names
189     our %STR2LEVEL = (
190 root 1.18 fatal => 1, emerg => 1, exit => 1,
191 root 1.2 alert => 2,
192     critical => 3, crit => 3,
193 root 1.18 error => 4, err => 4, die => 4,
194 root 1.2 warn => 5, warning => 5,
195     note => 6, notice => 6,
196     info => 7,
197     debug => 8,
198     trace => 9,
199     );
200    
201 root 1.4 sub now () { time }
202 root 1.10
203 root 1.4 AnyEvent::post_detect {
204     *now = \&AE::now;
205     };
206    
207 root 1.2 our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
208    
209 root 1.8 # time, ctx, level, msg
210     sub _format($$$$) {
211 root 1.11 my $ts = ft $_[0];
212     my $ct = " ";
213    
214 root 1.10 my @res;
215 root 1.8
216 root 1.10 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
217 root 1.11 push @res, "$ts$ct$_\n";
218     $ct = " + ";
219 root 1.10 }
220    
221     join "", @res
222 root 1.8 }
223    
224 root 1.3 sub _log {
225 root 1.8 my ($ctx, $level, $format, @args) = @_;
226 root 1.2
227 root 1.11 $level = $level > 0 && $level <= 9
228     ? $level+0
229     : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
230 root 1.2
231 root 1.8 my $mask = 1 << $level;
232 root 1.2
233 root 1.22 my ($success, %seen, @ctx, $now, $fmt);
234 root 1.8
235 root 1.11 do
236     {
237     # skip if masked
238     if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
239     if ($ctx->[3]) {
240     # logging target found
241    
242     # now get raw message, unless we have it already
243     unless ($now) {
244     $format = $format->() if ref $format;
245     $format = sprintf $format, @args if @args;
246     $format =~ s/\n$//;
247     $now = AE::now;
248     };
249    
250     # format msg
251     my $str = $ctx->[4]
252     ? $ctx->[4]($now, $_[0], $level, $format)
253 root 1.20 : ($fmt ||= _format $now, $_[0], $level, $format);
254 root 1.11
255 root 1.22 $success = 1;
256    
257 root 1.21 $ctx->[3]($str)
258 root 1.18 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
259     } else {
260     push @ctx, values %{ $ctx->[2] }; # not masked - propagate
261 root 1.11 }
262     }
263 root 1.8 }
264 root 1.11 while $ctx = pop @ctx;
265 root 1.2
266     exit 1 if $level <= 1;
267 root 1.22
268     $success
269 root 1.2 }
270    
271 root 1.3 sub log($$;@) {
272 root 1.8 _log
273     $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
274     @_;
275 root 1.3 }
276    
277 root 1.2 *AnyEvent::log = *AE::log = \&log;
278    
279 root 1.3 =item $logger = AnyEvent::Log::logger $level[, \$enabled]
280    
281     Creates a code reference that, when called, acts as if the
282 root 1.22 C<AnyEvent::Log::log> function was called at this point with the given
283 root 1.3 level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
284     the C<AnyEvent::Log::log> function:
285    
286     my $debug_log = AnyEvent::Log::logger "debug";
287    
288     $debug_log->("debug here");
289     $debug_log->("%06d emails processed", 12345);
290     $debug_log->(sub { $obj->as_string });
291    
292     The idea behind this function is to decide whether to log before actually
293     logging - when the C<logger> function is called once, but the returned
294     logger callback often, then this can be a tremendous speed win.
295    
296     Despite this speed advantage, changes in logging configuration will
297     still be reflected by the logger callback, even if configuration changes
298     I<after> it was created.
299    
300     To further speed up logging, you can bind a scalar variable to the logger,
301     which contains true if the logger should be called or not - if it is
302     false, calling the logger can be safely skipped. This variable will be
303     updated as long as C<$logger> is alive.
304    
305     Full example:
306    
307     # near the init section
308     use AnyEvent::Log;
309    
310     my $debug_log = AnyEvent:Log::logger debug => \my $debug;
311    
312     # and later in your program
313     $debug_log->("yo, stuff here") if $debug;
314    
315     $debug and $debug_log->("123");
316    
317     =cut
318    
319     our %LOGGER;
320    
321     # re-assess logging status for all loggers
322     sub _reassess {
323 root 1.17 local $SIG{__DIE__};
324     my $die = sub { die };
325    
326 root 1.3 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
327 root 1.8 my ($ctx, $level, $renabled) = @$_;
328 root 1.3
329 root 1.17 # to detect whether a message would be logged, we actually
330 root 1.11 # try to log one and die. this isn't fast, but we can be
331 root 1.3 # sure that the logging decision is correct :)
332    
333     $$renabled = !eval {
334 root 1.17 _log $ctx, $level, $die;
335 root 1.3
336     1
337     };
338     }
339     }
340    
341 root 1.15 sub _logger {
342 root 1.8 my ($ctx, $level, $renabled) = @_;
343 root 1.3
344     $$renabled = 1;
345    
346 root 1.8 my $logger = [$ctx, $level, $renabled];
347 root 1.3
348     $LOGGER{$logger+0} = $logger;
349    
350     _reassess $logger+0;
351    
352     my $guard = AnyEvent::Util::guard {
353     # "clean up"
354     delete $LOGGER{$logger+0};
355     };
356    
357     sub {
358     $guard if 0; # keep guard alive, but don't cause runtime overhead
359    
360 root 1.8 _log $ctx, $level, @_
361 root 1.3 if $$renabled;
362     }
363     }
364    
365 root 1.8 sub logger($;$) {
366     _logger
367     $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
368     @_
369     }
370    
371 root 1.2 =back
372    
373 root 1.9 =head1 LOGGING CONTEXTS
374 root 1.2
375 root 1.9 This module associates every log message with a so-called I<logging
376     context>, based on the package of the caller. Every perl package has its
377     own logging context.
378 root 1.8
379 root 1.10 A logging context has three major responsibilities: filtering, logging and
380     propagating the message.
381 root 1.9
382 root 1.10 For the first purpose, filtering, each context has a set of logging
383     levels, called the log level mask. Messages not in the set will be ignored
384     by this context (masked).
385    
386     For logging, the context stores a formatting callback (which takes the
387     timestamp, context, level and string message and formats it in the way
388     it should be logged) and a logging callback (which is responsible for
389     actually logging the formatted message and telling C<AnyEvent::Log>
390     whether it has consumed the message, or whether it should be propagated).
391 root 1.9
392 root 1.18 For propagation, a context can have any number of attached I<slave
393 root 1.10 contexts>. Any message that is neither masked by the logging mask nor
394 root 1.18 masked by the logging callback returning true will be passed to all slave
395 root 1.10 contexts.
396 root 1.9
397 root 1.11 Each call to a logging function will log the message at most once per
398     context, so it does not matter (much) if there are cycles or if the
399     message can arrive at the same context via multiple paths.
400    
401 root 1.9 =head2 DEFAULTS
402    
403 root 1.10 By default, all logging contexts have an full set of log levels ("all"), a
404 root 1.9 disabled logging callback and the default formatting callback.
405    
406     Package contexts have the package name as logging title by default.
407    
408 root 1.18 They have exactly one slave - the context of the "parent" package. The
409 root 1.9 parent package is simply defined to be the package name without the last
410     component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
411 root 1.18 and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
412     exception of the rule - just like the "parent" of any single-component
413     package name in Perl is C<main>, the default slave of any top-level
414     package context is C<$AnyEvent::Log::COLLECT>.
415 root 1.9
416 root 1.18 Since perl packages form only an approximate hierarchy, this slave
417 root 1.9 context can of course be removed.
418    
419 root 1.18 All other (anonymous) contexts have no slaves and an empty title by
420 root 1.9 default.
421    
422 root 1.18 When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
423     context that simply logs everything via C<warn>, without propagating
424     anything anywhere by default. The purpose of this context is to provide
425 root 1.12 a convenient place to override the global logging target or to attach
426     additional log targets. It's not meant for filtering.
427    
428 root 1.18 It then creates the C<$AnyEvent::Log::FILTER> context whose
429     purpose is to suppress all messages with priority higher
430     than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
431     C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
432     is to simply provide filtering according to some global log level.
433    
434     Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
435     and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
436     leaves it at default config. Its purpose is simply to collect all log
437     messages system-wide.
438    
439     The hierarchy is then:
440    
441     any package, eventually -> $COLLECT -> $FILTER -> $LOG
442    
443     The effect of all this is that log messages, by default, wander up to the
444     C<$AnyEvent::Log::COLLECT> context where all messages normally end up,
445     from there to C<$AnyEvent::Log::FILTER> where log messages with lower
446     priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
447     to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
448    
449     This makes it easy to set a global logging level (by modifying $FILTER),
450     but still allow other contexts to send, for example, their debug and trace
451     messages to the $LOG target despite the global logging level, or to attach
452     additional log targets that log messages, regardless of the global logging
453     level.
454    
455     It also makes it easy to modify the default warn-logger ($LOG) to
456     something that logs to a file, or to attach additional logging targets
457     (such as loggign to a file) by attaching it to $FILTER.
458 root 1.9
459 root 1.11 =head2 CREATING/FINDING/DESTROYING CONTEXTS
460 root 1.2
461     =over 4
462    
463 root 1.8 =item $ctx = AnyEvent::Log::ctx [$pkg]
464    
465 root 1.9 This function creates or returns a logging context (which is an object).
466 root 1.8
467 root 1.9 If a package name is given, then the context for that packlage is
468     returned. If it is called without any arguments, then the context for the
469     callers package is returned (i.e. the same context as a C<AE::log> call
470     would use).
471 root 1.8
472     If C<undef> is given, then it creates a new anonymous context that is not
473     tied to any package and is destroyed when no longer referenced.
474    
475     =cut
476    
477     sub ctx(;$) {
478     my $pkg = @_ ? shift : (caller)[0];
479    
480     ref $pkg
481     ? $pkg
482     : defined $pkg
483     ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg
484 root 1.10 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
485 root 1.8 }
486    
487 root 1.11 =item AnyEvent::Log::reset
488    
489 root 1.16 Resets all package contexts and recreates the default hierarchy if
490     necessary, i.e. resets the logging subsystem to defaults, as much as
491     possible. This process keeps references to contexts held by other parts of
492     the program intact.
493 root 1.11
494     This can be used to implement config-file (re-)loading: before loading a
495     configuration, reset all contexts.
496    
497     =cut
498    
499     sub reset {
500 root 1.15 # hard to kill complex data structures
501 root 1.19 # we "recreate" all package loggers and reset the hierarchy
502 root 1.15 while (my ($k, $v) = each %CTX) {
503     @$v = ($k, (1 << 10) - 1 - 1, { });
504    
505 root 1.19 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
506 root 1.15 }
507 root 1.11
508 root 1.19 @$_ = ($_->[0], (1 << 10) - 1 - 1)
509     for $LOG, $FILTER, $COLLECT;
510    
511 root 1.18 $LOG->slaves;
512     $LOG->title ('$AnyEvent::Log::LOG');
513     $LOG->log_cb (sub {
514 root 1.15 warn shift;
515 root 1.8 0
516     });
517 root 1.15
518 root 1.18 $FILTER->slaves ($LOG);
519     $FILTER->title ('$AnyEvent::Log::FILTER');
520     $FILTER->level ($AnyEvent::VERBOSE);
521    
522     $COLLECT->slaves ($FILTER);
523 root 1.19 $COLLECT->title ('$AnyEvent::Log::COLLECT');
524 root 1.15
525     _reassess;
526 root 1.11 }
527    
528 root 1.15 # create the default logger contexts
529 root 1.18 $LOG = ctx undef;
530     $FILTER = ctx undef;
531     $COLLECT = ctx undef;
532 root 1.15
533 root 1.11 AnyEvent::Log::reset;
534    
535 root 1.12 # hello, CPAN, please catch me
536 root 1.18 package AnyEvent::Log::LOG;
537     package AE::Log::LOG;
538     package AnyEvent::Log::FILTER;
539     package AE::Log::FILTER;
540     package AnyEvent::Log::COLLECT;
541     package AE::Log::COLLECT;
542 root 1.8
543 root 1.12 package AnyEvent::Log::Ctx;
544    
545 root 1.18 # 0 1 2 3 4
546     # [$title, $level, %$slaves, &$logcb, &$fmtcb]
547 root 1.12
548     =item $ctx = new AnyEvent::Log::Ctx methodname => param...
549    
550     This is a convenience constructor that makes it simpler to construct
551     anonymous logging contexts.
552    
553     Each key-value pair results in an invocation of the method of the same
554     name as the key with the value as parameter, unless the value is an
555     arrayref, in which case it calls the method with the contents of the
556     array. The methods are called in the same order as specified.
557    
558     Example: create a new logging context and set both the default logging
559 root 1.18 level, some slave contexts and a logging callback.
560 root 1.12
561     $ctx = new AnyEvent::Log::Ctx
562     title => "dubious messages",
563     level => "error",
564     log_cb => sub { print STDOUT shift; 0 },
565 root 1.18 slaves => [$ctx1, $ctx, $ctx2],
566 root 1.12 ;
567    
568 root 1.9 =back
569    
570     =cut
571    
572 root 1.12 sub new {
573     my $class = shift;
574    
575     my $ctx = AnyEvent::Log::ctx undef;
576    
577     while (@_) {
578     my ($k, $v) = splice @_, 0, 2;
579     $ctx->$k (ref $v eq "ARRAY" ? @$v : $v);
580     }
581    
582     bless $ctx, $class # do we really support subclassing, hmm?
583     }
584 root 1.8
585    
586 root 1.9 =head2 CONFIGURING A LOG CONTEXT
587    
588     The following methods can be used to configure the logging context.
589    
590     =over 4
591    
592 root 1.8 =item $ctx->title ([$new_title])
593    
594     Returns the title of the logging context - this is the package name, for
595     package contexts, and a user defined string for all others.
596    
597     If C<$new_title> is given, then it replaces the package name or title.
598    
599     =cut
600    
601     sub title {
602     $_[0][0] = $_[1] if @_ > 1;
603     $_[0][0]
604     }
605    
606 root 1.9 =back
607    
608     =head3 LOGGING LEVELS
609    
610 root 1.10 The following methods deal with the logging level set associated with the
611     log context.
612 root 1.9
613     The most common method to use is probably C<< $ctx->level ($level) >>,
614     which configures the specified and any higher priority levels.
615    
616 root 1.10 All functions which accept a list of levels also accept the special string
617     C<all> which expands to all logging levels.
618    
619 root 1.9 =over 4
620    
621 root 1.8 =item $ctx->levels ($level[, $level...)
622    
623 root 1.10 Enables logging for the given levels and disables it for all others.
624 root 1.8
625     =item $ctx->level ($level)
626    
627     Enables logging for the given level and all lower level (higher priority)
628 root 1.10 ones. In addition to normal logging levels, specifying a level of C<0> or
629     C<off> disables all logging for this level.
630 root 1.8
631     Example: log warnings, errors and higher priority messages.
632    
633     $ctx->level ("warn");
634     $ctx->level (5); # same thing, just numeric
635    
636     =item $ctx->enable ($level[, $level...])
637    
638     Enables logging for the given levels, leaving all others unchanged.
639 root 1.5
640 root 1.8 =item $ctx->disable ($level[, $level...])
641    
642     Disables logging for the given levels, leaving all others unchanged.
643    
644     =cut
645    
646     sub _lvl_lst {
647 root 1.10 map {
648     $_ > 0 && $_ <= 9 ? $_+0
649     : $_ eq "all" ? (1 .. 9)
650     : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
651     } @_
652 root 1.8 }
653    
654     our $NOP_CB = sub { 0 };
655    
656     sub levels {
657     my $ctx = shift;
658     $ctx->[1] = 0;
659     $ctx->[1] |= 1 << $_
660     for &_lvl_lst;
661     AnyEvent::Log::_reassess;
662     }
663    
664     sub level {
665     my $ctx = shift;
666 root 1.10 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
667    
668 root 1.8 $ctx->[1] = ((1 << $lvl) - 1) << 1;
669     AnyEvent::Log::_reassess;
670     }
671    
672     sub enable {
673     my $ctx = shift;
674     $ctx->[1] |= 1 << $_
675     for &_lvl_lst;
676     AnyEvent::Log::_reassess;
677     }
678    
679     sub disable {
680     my $ctx = shift;
681     $ctx->[1] &= ~(1 << $_)
682     for &_lvl_lst;
683     AnyEvent::Log::_reassess;
684     }
685    
686 root 1.9 =back
687    
688 root 1.18 =head3 SLAVE CONTEXTS
689 root 1.9
690     The following methods attach and detach another logging context to a
691     logging context.
692    
693 root 1.18 Log messages are propagated to all slave contexts, unless the logging
694 root 1.9 callback consumes the message.
695    
696     =over 4
697    
698 root 1.8 =item $ctx->attach ($ctx2[, $ctx3...])
699    
700 root 1.18 Attaches the given contexts as slaves to this context. It is not an error
701 root 1.8 to add a context twice (the second add will be ignored).
702    
703     A context can be specified either as package name or as a context object.
704    
705     =item $ctx->detach ($ctx2[, $ctx3...])
706    
707 root 1.18 Removes the given slaves from this context - it's not an error to attempt
708 root 1.8 to remove a context that hasn't been added.
709    
710     A context can be specified either as package name or as a context object.
711 root 1.5
712 root 1.18 =item $ctx->slaves ($ctx2[, $ctx3...])
713 root 1.11
714 root 1.18 Replaces all slaves attached to this context by the ones given.
715 root 1.11
716 root 1.2 =cut
717    
718 root 1.8 sub attach {
719     my $ctx = shift;
720    
721     $ctx->[2]{$_+0} = $_
722     for map { AnyEvent::Log::ctx $_ } @_;
723     }
724    
725     sub detach {
726     my $ctx = shift;
727    
728     delete $ctx->[2]{$_+0}
729     for map { AnyEvent::Log::ctx $_ } @_;
730     }
731    
732 root 1.18 sub slaves {
733 root 1.11 undef $_[0][2];
734     &attach;
735     }
736    
737 root 1.9 =back
738    
739 root 1.18 =head3 LOG TARGETS
740 root 1.9
741     The following methods configure how the logging context actually does
742 root 1.10 the logging (which consists of formatting the message and printing it or
743 root 1.18 whatever it wants to do with it).
744 root 1.9
745     =over 4
746    
747 root 1.21 =item $ctx->log_cb ($cb->($str)
748 root 1.5
749 root 1.8 Replaces the logging callback on the context (C<undef> disables the
750     logging callback).
751 root 1.5
752 root 1.8 The logging callback is responsible for handling formatted log messages
753     (see C<fmt_cb> below) - normally simple text strings that end with a
754 root 1.21 newline (and are possibly multiline themselves).
755 root 1.8
756     It also has to return true iff it has consumed the log message, and false
757     if it hasn't. Consuming a message means that it will not be sent to any
758 root 1.18 slave context. When in doubt, return C<0> from your logging callback.
759 root 1.8
760     Example: a very simple logging callback, simply dump the message to STDOUT
761     and do not consume it.
762    
763     $ctx->log_cb (sub { print STDERR shift; 0 });
764    
765 root 1.10 You can filter messages by having a log callback that simply returns C<1>
766     and does not do anything with the message, but this counts as "message
767     being logged" and might not be very efficient.
768    
769     Example: propagate all messages except for log levels "debug" and
770     "trace". The messages will still be generated, though, which can slow down
771     your program.
772    
773     $ctx->levels ("debug", "trace");
774     $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
775    
776 root 1.20 =item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
777 root 1.8
778 root 1.10 Replaces the formatting callback on the context (C<undef> restores the
779 root 1.8 default formatter).
780    
781     The callback is passed the (possibly fractional) timestamp, the original
782 root 1.18 logging context, the (numeric) logging level and the raw message string
783     and needs to return a formatted log message. In most cases this will be a
784     string, but it could just as well be an array reference that just stores
785     the values.
786    
787     If, for some reaosn, you want to use C<caller> to find out more baout the
788     logger then you should walk up the call stack until you are no longer
789     inside the C<AnyEvent::Log> package.
790 root 1.8
791     Example: format just the raw message, with numeric log level in angle
792     brackets.
793    
794     $ctx->fmt_cb (sub {
795     my ($time, $ctx, $lvl, $msg) = @_;
796    
797     "<$lvl>$msg\n"
798     });
799    
800     Example: return an array reference with just the log values, and use
801     C<PApp::SQL::sql_exec> to store the emssage in a database.
802    
803     $ctx->fmt_cb (sub { \@_ });
804     $ctx->log_cb (sub {
805     my ($msg) = @_;
806    
807     sql_exec "insert into log (when, subsys, prio, msg) values (?, ?, ?, ?)",
808     $msg->[0] + 0,
809     "$msg->[1]",
810     $msg->[2] + 0,
811     "$msg->[3]";
812    
813     0
814     });
815    
816 root 1.21 =item $ctx->log_to_file ($path)
817    
818     Sets the C<log_cb> to log to a file (by appending), unbuffered.
819    
820     =item $ctx->log_to_path ($path)
821    
822     Same as C<< ->log_to_file >>, but opens the file for each message. This
823     is much slower, but allows you to change/move/rename/delete the file at
824     basically any time.
825    
826     =item $ctx->log_to_syslog ([$log_flags])
827    
828     Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all
829     the others in the obvious way. If specified, then the C<$log_flags> are
830     simply or'ed onto the priority argument and can contain any C<LOG_xxx>
831     flags valid for Sys::Syslog::syslog, except for the priority levels.
832    
833     Note that this function also sets a C<fmt_cb> - the logging part requires
834     an array reference with [$level, $str] as input.
835    
836 root 1.8 =cut
837    
838     sub log_cb {
839     my ($ctx, $cb) = @_;
840 root 1.6
841 root 1.10 $ctx->[3] = $cb;
842 root 1.6 }
843 root 1.5
844 root 1.8 sub fmt_cb {
845     my ($ctx, $cb) = @_;
846 root 1.6
847 root 1.8 $ctx->[4] = $cb;
848 root 1.5 }
849    
850 root 1.18 sub log_to_file {
851     my ($ctx, $path) = @_;
852    
853     open my $fh, ">>", $path
854     or die "$path: $!";
855    
856     $ctx->log_cb (sub {
857     syswrite $fh, shift;
858     0
859     });
860     }
861    
862     sub log_to_file {
863     my ($ctx, $path) = @_;
864    
865     $ctx->log_cb (sub {
866     open my $fh, ">>", $path
867     or die "$path: $!";
868    
869     syswrite $fh, shift;
870     0
871     });
872     }
873    
874 root 1.20 sub log_to_syslog {
875     my ($ctx, $flags) = @_;
876    
877     require Sys::Syslog;
878    
879 root 1.21 $ctx->fmt_cb (sub {
880     my $str = $_[3];
881     $str =~ s/\n(?=.)/\n+ /g;
882    
883     [$_[2], "($_[1][0]) $str"]
884     });
885    
886 root 1.20 $ctx->log_cb (sub {
887 root 1.21 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
888 root 1.20
889     Sys::Syslog::syslog ($flags | ($lvl - 1), $_)
890 root 1.21 for split /\n/, $_[0][1];
891 root 1.20
892     0
893     });
894     }
895    
896 root 1.18 =back
897    
898     =head3 MESSAGE LOGGING
899    
900     These methods allow you to log messages directly to a context, without
901     going via your package context.
902    
903     =over 4
904    
905 root 1.8 =item $ctx->log ($level, $msg[, @params])
906    
907     Same as C<AnyEvent::Log::log>, but uses the given context as log context.
908    
909     =item $logger = $ctx->logger ($level[, \$enabled])
910    
911     Same as C<AnyEvent::Log::logger>, but uses the given context as log
912     context.
913    
914     =cut
915    
916     *log = \&AnyEvent::Log::_log;
917     *logger = \&AnyEvent::Log::_logger;
918    
919 root 1.1 1;
920    
921     =back
922    
923 root 1.12 =head1 EXAMPLES
924    
925     This section shows some common configurations.
926    
927     =over 4
928    
929     =item Setting the global logging level.
930    
931     Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before
932     running your program, or modify the log level of the root context:
933    
934     PERL_ANYEVENT_VERBOSE=5 ./myprog
935    
936 root 1.18 $AnyEvent::Log::FILTER->level ("warn");
937 root 1.12
938     =item Append all messages to a file instead of sending them to STDERR.
939    
940     This is affected by the global logging level.
941    
942 root 1.18 $AnyEvent::Log::LOG->log_to_file ($path); (sub {
943 root 1.12
944     =item Write all messages with priority C<error> and higher to a file.
945    
946     This writes them only when the global logging level allows it, because
947     it is attached to the default context which is invoked I<after> global
948     filtering.
949    
950 root 1.18 $AnyEvent::Log::FILTER->attach
951     new AnyEvent::Log::Ctx log_to_file => $path);
952 root 1.12
953     This writes them regardless of the global logging level, because it is
954     attached to the toplevel context, which receives all messages I<before>
955     the global filtering.
956    
957 root 1.18 $AnyEvent::Log::COLLECT->attach (
958     new AnyEvent::Log::Ctx log_to_file => $path);
959 root 1.12
960 root 1.18 In both cases, messages are still written to STDERR.
961 root 1.12
962     =item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
963    
964 root 1.18 Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
965     context - this simply circumvents the global filtering for trace messages.
966 root 1.12
967     my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
968 root 1.18 $debug->attach ($AnyEvent::Log::LOG);
969 root 1.12
970 root 1.18 This of course works for any package, not just L<AnyEvent::Debug>, but
971     assumes the log level for AnyEvent::Debug hasn't been changed from the
972     default.
973 root 1.13
974 root 1.12 =back
975    
976 root 1.1 =head1 AUTHOR
977    
978     Marc Lehmann <schmorp@schmorp.de>
979     http://home.schmorp.de/
980    
981     =cut