ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Log.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Log.pm (file contents):
Revision 1.2 by root, Tue Aug 16 14:47:27 2011 UTC vs.
Revision 1.38 by root, Fri Aug 26 00:32:45 2011 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines