ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Log.pm
Revision: 1.15
Committed: Sat Aug 20 02:16:59 2011 UTC (12 years, 10 months ago) by root
Branch: MAIN
Changes since 1.14: +38 -26 lines
Log Message:
reset

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