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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines