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