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