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.18 by root, Sat Aug 20 15:57:35 2011 UTC vs.
Revision 1.48 by root, Thu Mar 22 00:19:39 2012 UTC

… …
2 2
3AnyEvent::Log - simple logging "framework" 3AnyEvent::Log - simple logging "framework"
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 # simple use 7Simple uses:
8
8 use AnyEvent; 9 use AnyEvent;
9 10
10 AE::log debug => "hit my knee"; 11 AE::log trace => "going to call function abc";
11 AE::log warn => "it's a bit too hot"; 12 AE::log debug => "the function returned 3";
12 AE::log error => "the flag was false!"; 13 AE::log info => "file soandso successfully deleted";
13 AE::log fatal => "the bit toggled! run!"; 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
14 20
15 # "complex" use 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
16 use AnyEvent::Log; 36 use AnyEvent::Log;
17 37
18 my $tracer = AnyEvent::Log::logger trace => \$my $trace; 38 my $tracer = AnyEvent::Log::logger trace => \$my $trace;
19 39
20 $tracer->("i am here") if $trace; 40 $tracer->("i am here") if $trace;
21 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; 41 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
22 42
23 # configuration 43Configuration (also look at the EXAMPLES section):
24 44
25 # set logging for the current package to errors and higher only 45 # set logging for the current package to errors and higher only
26 AnyEvent::Log::ctx->level ("error"); 46 AnyEvent::Log::ctx->level ("error");
27 47
28 # set logging globally to anything below debug 48 # set logging level to suppress anything below "notice"
29 $AnyEvent::Log::FILTER->level ("notice"); 49 $AnyEvent::Log::FILTER->level ("notice");
30 50
31 # see also EXAMPLES, below 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 );
32 57
33=head1 DESCRIPTION 58=head1 DESCRIPTION
34 59
35This module implements a relatively simple "logging framework". It doesn't 60This module implements a relatively simple "logging framework". It doesn't
36attempt to be "the" logging solution or even "a" logging solution for 61attempt to be "the" logging solution or even "a" logging solution for
37AnyEvent - AnyEvent simply creates logging messages internally, and this 62AnyEvent - AnyEvent simply creates logging messages internally, and this
38module 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
39using it from other modules as well. 64using it from other modules as well.
40 65
41Remember that the default verbosity level is C<0>, so nothing will be 66Remember that the default verbosity level is C<3> (C<critical>), so little
42logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number before 67will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
43starting your program, or change the logging level at runtime with 68before starting your program, or change the logging level at runtime with
44something like: 69something like:
45 70
46 use AnyEvent::Log; 71 use AnyEvent::Log;
47 AnyEvent::Log::FILTER->level ("info"); 72 $AnyEvent::Log::FILTER->level ("info");
48 73
49The design goal behind this module was to keep it simple (and small), 74The design goal behind this module was to keep it simple (and small),
50but make it powerful enough to be potentially useful for any module, and 75but make it powerful enough to be potentially useful for any module, and
51extensive enough for the most common tasks, such as logging to multiple 76extensive enough for the most common tasks, such as logging to multiple
52targets, or being able to log into a database. 77targets, or being able to log into a database.
53 78
79The module is also usable before AnyEvent itself is initialised, in which
80case some of the functionality might be reduced.
81
54The amount of documentation might indicate otherwise, but the module is 82The amount of documentation might indicate otherwise, but the runtime part
55still just below 300 lines of code. 83of the module is still just below 300 lines of code.
56 84
57=head1 LOGGING LEVELS 85=head1 LOGGING LEVELS
58 86
59Logging levels in this module range from C<1> (highest priority) to C<9> 87Logging levels in this module range from C<1> (highest priority) to C<9>
60(lowest priority). Note that the lowest numerical value is the highest 88(lowest priority). Note that the lowest numerical value is the highest
… …
62numerical value". 90numerical value".
63 91
64Instead of specifying levels by name you can also specify them by aliases: 92Instead of specifying levels by name you can also specify them by aliases:
65 93
66 LVL NAME SYSLOG PERL NOTE 94 LVL NAME SYSLOG PERL NOTE
67 1 fatal emerg exit aborts program! 95 1 fatal emerg exit system unusable, aborts program!
68 2 alert 96 2 alert failure in primary system
69 3 critical crit 97 3 critical crit failure in backup system
70 4 error err die 98 4 error err die non-urgent program errors, a bug
71 5 warn warning 99 5 warn warning possible problem, not necessarily error
72 6 note notice 100 6 note notice unusual conditions
73 7 info 101 7 info normal messages, no action required
74 8 debug 102 8 debug debugging messages for development
75 9 trace 103 9 trace copious tracing output
76 104
77As you can see, some logging levels have multiple aliases - the first one 105As you can see, some logging levels have multiple aliases - the first one
78is the "official" name, the second one the "syslog" name (if it differs) 106is the "official" name, the second one the "syslog" name (if it differs)
79and the third one the "perl" name, suggesting that you log C<die> messages 107and the third one the "perl" name, suggesting (only!) that you log C<die>
80at C<error> priority. 108messages at C<error> priority. The NOTE column tries to provide some
109rationale on how to chose a logging level.
81 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
82You can normally only log a single message at highest priority level 116You can normally only log a message once at highest priority level (C<1>,
83(C<1>, C<fatal>), because logging a fatal message will also quit the 117C<fatal>), because logging a fatal message will also quit the program - so
84program - so use it sparingly :) 118use it sparingly :)
85 119
86Some methods also offer some extra levels, such as C<0>, C<off>, C<none> 120Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
87or C<all> - these are only valid in the methods they are documented for. 121or C<all> - these are only valid for the methods that documented them.
88 122
89=head1 LOGGING FUNCTIONS 123=head1 LOGGING FUNCTIONS
90 124
91These functions allow you to log messages. They always use the caller's 125The following functions allow you to log messages. They always use the
92package as a "logging context". Also, the main logging function C<log> is 126caller's package as a "logging context". Also, the main logging function,
93callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is 127C<log>, is aliased to C<AnyEvent::log> and C<AE::log> when the C<AnyEvent>
94loaded. 128module is loaded.
95 129
96=over 4 130=over 4
97 131
98=cut 132=cut
99 133
100package AnyEvent::Log; 134package AnyEvent::Log;
101 135
102use Carp (); 136use Carp ();
103use POSIX (); 137use POSIX ();
104 138
139# layout of a context
140# 0 1 2 3 4, 5
141# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
142
105use AnyEvent (); BEGIN { AnyEvent::common_sense } 143use AnyEvent (); BEGIN { AnyEvent::common_sense }
106use AnyEvent::Util (); 144#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
107 145
108our $VERSION = $AnyEvent::VERSION; 146our $VERSION = $AnyEvent::VERSION;
109 147
110our ($COLLECT, $FILTER, $LOG); 148our ($COLLECT, $FILTER, $LOG);
111 149
… …
138 $ctx 176 $ctx
139} 177}
140 178
141=item AnyEvent::Log::log $level, $msg[, @args] 179=item AnyEvent::Log::log $level, $msg[, @args]
142 180
143Requests logging of the given C<$msg> with the given log level. 181Requests logging of the given C<$msg> with the given log level, and
182returns true if the message was logged I<somewhere>.
144 183
145For C<fatal> log levels, the program will abort. 184For loglevel C<fatal>, the program will abort.
146 185
147If 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
148C<$msg> is interpreted as an sprintf format string. 187C<$msg> is interpreted as an sprintf format string.
149 188
150The 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
… …
153Last not least, C<$msg> might be a code reference, in which case it is 192Last not least, C<$msg> might be a code reference, in which case it is
154supposed to return the message. It will be called only then the message 193supposed to return the message. It will be called only then the message
155actually gets logged, which is useful if it is costly to create the 194actually gets logged, which is useful if it is costly to create the
156message in the first place. 195message in the first place.
157 196
197This function takes care of saving and restoring C<$!> and C<$@>, so you
198don't have to.
199
158Whether 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
159and 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.
160 205
161Note 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
162C<AE::log>, without C<use>-ing this module if possible (i.e. you don't 207C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
163need any additional functionality), as those functions will load the 208need any additional functionality), as those functions will load the
164logging module on demand only. They are also much shorter to write. 209logging module on demand only. They are also much shorter to write.
… …
192 info => 7, 237 info => 7,
193 debug => 8, 238 debug => 8,
194 trace => 9, 239 trace => 9,
195); 240);
196 241
197sub now () { time } 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}
198 254
199AnyEvent::post_detect { 255AnyEvent::post_detect {
200 *now = \&AE::now; 256 exact_time $TIME_EXACT;
201}; 257};
202 258
203our @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);
204 260
205# time, ctx, level, msg 261# time, ctx, level, msg
… …
215 } 271 }
216 272
217 join "", @res 273 join "", @res
218} 274}
219 275
276sub fatal_exit() {
277 exit 1;
278}
279
220sub _log { 280sub _log {
221 my ($ctx, $level, $format, @args) = @_; 281 my ($ctx, $level, $format, @args) = @_;
222 282
223 $level = $level > 0 && $level <= 9 283 $level = $level > 0 && $level <= 9
224 ? $level+0 284 ? $level+0
225 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 285 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
226 286
227 my $mask = 1 << $level; 287 my $mask = 1 << $level;
228 288
229 my (%seen, @ctx, $now, $fmt); 289 my ($success, %seen, @ctx, $now, @fmt);
230 290
231 do 291 do
232 { 292 {
233 # skip if masked 293 # if !ref, then it's a level number
294 if (!ref $ctx) {
295 $level = $ctx;
234 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) { 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
235 if ($ctx->[3]) { 306 if ($ctx->[3]) {
236 # logging target found 307 # logging target found
308
309 local ($!, $@);
237 310
238 # now get raw message, unless we have it already 311 # now get raw message, unless we have it already
239 unless ($now) { 312 unless ($now) {
240 $format = $format->() if ref $format; 313 $format = $format->() if ref $format;
241 $format = sprintf $format, @args if @args; 314 $format = sprintf $format, @args if @args;
242 $format =~ s/\n$//; 315 $format =~ s/\n$//;
243 $now = AE::now; 316 $now = _ts;
244 }; 317 };
245 318
246 # format msg 319 # format msg
247 my $str = $ctx->[4] 320 my $str = $ctx->[4]
248 ? $ctx->[4]($now, $_[0], $level, $format) 321 ? $ctx->[4]($now, $_[0], $level, $format)
249 : $fmt ||= _format $now, $_[0], $level, $format; 322 : ($fmt[$level] ||= _format $now, $_[0], $level, $format);
323
324 $success = 1;
250 325
251 $ctx->[3]($str) 326 $ctx->[3]($str)
252 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 327 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
253 } else { 328 } else {
254 push @ctx, values %{ $ctx->[2] }; # not masked - propagate 329 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
255 } 330 }
256 } 331 }
257 } 332 }
258 while $ctx = pop @ctx; 333 while $ctx = pop @ctx;
259 334
260 exit 1 if $level <= 1; 335 fatal_exit if $level <= 1;
336
337 $success
261} 338}
262 339
263sub log($$;@) { 340sub log($$;@) {
264 _log 341 _log
265 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 342 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
266 @_; 343 @_;
267} 344}
268 345
269*AnyEvent::log = *AE::log = \&log;
270
271=item $logger = AnyEvent::Log::logger $level[, \$enabled] 346=item $logger = AnyEvent::Log::logger $level[, \$enabled]
272 347
273Creates a code reference that, when called, acts as if the 348Creates a code reference that, when called, acts as if the
274C<AnyEvent::Log::log> function was called at this point with the givne 349C<AnyEvent::Log::log> function was called at this point with the given
275level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with 350level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
276the C<AnyEvent::Log::log> function: 351the C<AnyEvent::Log::log> function:
277 352
278 my $debug_log = AnyEvent::Log::logger "debug"; 353 my $debug_log = AnyEvent::Log::logger "debug";
279 354
… …
339 414
340 $LOGGER{$logger+0} = $logger; 415 $LOGGER{$logger+0} = $logger;
341 416
342 _reassess $logger+0; 417 _reassess $logger+0;
343 418
419 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
344 my $guard = AnyEvent::Util::guard { 420 my $guard = AnyEvent::Util::guard (sub {
345 # "clean up" 421 # "clean up"
346 delete $LOGGER{$logger+0}; 422 delete $LOGGER{$logger+0};
347 }; 423 });
348 424
349 sub { 425 sub {
350 $guard if 0; # keep guard alive, but don't cause runtime overhead 426 $guard if 0; # keep guard alive, but don't cause runtime overhead
351 427
352 _log $ctx, $level, @_ 428 _log $ctx, $level, @_
… …
357sub logger($;$) { 433sub logger($;$) {
358 _logger 434 _logger
359 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 435 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
360 @_ 436 @_
361} 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.
362 453
363=back 454=back
364 455
365=head1 LOGGING CONTEXTS 456=head1 LOGGING CONTEXTS
366 457
… …
486This can be used to implement config-file (re-)loading: before loading a 577This can be used to implement config-file (re-)loading: before loading a
487configuration, reset all contexts. 578configuration, reset all contexts.
488 579
489=cut 580=cut
490 581
582our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
583$AnyEvent::VERBOSE = 9;
584
491sub reset { 585sub reset {
492 # hard to kill complex data structures 586 # hard to kill complex data structures
493 # we recreate all package loggers and reset the hierarchy 587 # we "recreate" all package loggers and reset the hierarchy
494 while (my ($k, $v) = each %CTX) { 588 while (my ($k, $v) = each %CTX) {
495 @$v = ($k, (1 << 10) - 1 - 1, { }); 589 @$v = ($k, (1 << 10) - 1 - 1, { });
496 590
497 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log); 591 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
498 } 592 }
499 593
594 @$_ = ($_->[0], (1 << 10) - 1 - 1)
595 for $LOG, $FILTER, $COLLECT;
596
500 $LOG->slaves; 597 #$LOG->slaves;
501 $LOG->title ('$AnyEvent::Log::LOG'); 598 $LOG->title ('$AnyEvent::Log::LOG');
502 $LOG->log_cb (sub { 599 $LOG->log_to_warn;
503 warn shift;
504 0
505 });
506 600
507 $FILTER->slaves ($LOG); 601 $FILTER->slaves ($LOG);
508 $FILTER->title ('$AnyEvent::Log::FILTER'); 602 $FILTER->title ('$AnyEvent::Log::FILTER');
509 $FILTER->level ($AnyEvent::VERBOSE); 603 $FILTER->level ($ORIG_VERBOSE);
510 604
511 $COLLECT->slaves ($FILTER); 605 $COLLECT->slaves ($FILTER);
512 $COLLECT->title ('$AnyEvent::Log::FILTER'); 606 $COLLECT->title ('$AnyEvent::Log::COLLECT');
513 607
514 _reassess; 608 _reassess;
515} 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;
516 618
517# create the default logger contexts 619# create the default logger contexts
518$LOG = ctx undef; 620$LOG = ctx undef;
519$FILTER = ctx undef; 621$FILTER = ctx undef;
520$COLLECT = ctx undef; 622$COLLECT = ctx undef;
… …
529package AnyEvent::Log::COLLECT; 631package AnyEvent::Log::COLLECT;
530package AE::Log::COLLECT; 632package AE::Log::COLLECT;
531 633
532package AnyEvent::Log::Ctx; 634package AnyEvent::Log::Ctx;
533 635
534# 0 1 2 3 4
535# [$title, $level, %$slaves, &$logcb, &$fmtcb]
536
537=item $ctx = new AnyEvent::Log::Ctx methodname => param... 636=item $ctx = new AnyEvent::Log::Ctx methodname => param...
538 637
539This is a convenience constructor that makes it simpler to construct 638This is a convenience constructor that makes it simpler to construct
540anonymous logging contexts. 639anonymous logging contexts.
541 640
… …
628 727
629=item $ctx->disable ($level[, $level...]) 728=item $ctx->disable ($level[, $level...])
630 729
631Disables logging for the given levels, leaving all others unchanged. 730Disables logging for the given levels, leaving all others unchanged.
632 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
633=cut 754=cut
634 755
635sub _lvl_lst { 756sub _lvl_lst {
636 map { 757 map {
637 $_ > 0 && $_ <= 9 ? $_+0 758 $_ > 0 && $_ <= 9 ? $_+0
638 : $_ eq "all" ? (1 .. 9) 759 : $_ eq "all" ? (1 .. 9)
639 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 760 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
640 } @_ 761 } @_
641} 762}
642 763
764sub _lvl {
765 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
766}
767
643our $NOP_CB = sub { 0 }; 768our $NOP_CB = sub { 0 };
644 769
645sub levels { 770sub levels {
646 my $ctx = shift; 771 my $ctx = shift;
647 $ctx->[1] = 0; 772 $ctx->[1] = 0;
… …
650 AnyEvent::Log::_reassess; 775 AnyEvent::Log::_reassess;
651} 776}
652 777
653sub level { 778sub level {
654 my $ctx = shift; 779 my $ctx = shift;
655 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
656
657 $ctx->[1] = ((1 << $lvl) - 1) << 1; 780 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
658 AnyEvent::Log::_reassess; 781 AnyEvent::Log::_reassess;
659} 782}
660 783
661sub enable { 784sub enable {
662 my $ctx = shift; 785 my $ctx = shift;
… …
670 $ctx->[1] &= ~(1 << $_) 793 $ctx->[1] &= ~(1 << $_)
671 for &_lvl_lst; 794 for &_lvl_lst;
672 AnyEvent::Log::_reassess; 795 AnyEvent::Log::_reassess;
673} 796}
674 797
798sub cap {
799 my $ctx = shift;
800 $ctx->[5] = &_lvl;
801}
802
675=back 803=back
676 804
677=head3 SLAVE CONTEXTS 805=head3 SLAVE CONTEXTS
678 806
679The following methods attach and detach another logging context to a 807The following methods attach and detach another logging context to a
… …
731the logging (which consists of formatting the message and printing it or 859the logging (which consists of formatting the message and printing it or
732whatever it wants to do with it). 860whatever it wants to do with it).
733 861
734=over 4 862=over 4
735 863
736=item $ctx->log_cb ($cb->($str)) 864=item $ctx->log_cb ($cb->($str)
737 865
738Replaces the logging callback on the context (C<undef> disables the 866Replaces the logging callback on the context (C<undef> disables the
739logging callback). 867logging callback).
740 868
741The logging callback is responsible for handling formatted log messages 869The logging callback is responsible for handling formatted log messages
… …
760your program. 888your program.
761 889
762 $ctx->levels ("debug", "trace"); 890 $ctx->levels ("debug", "trace");
763 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages 891 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
764 892
765=item $ctx->log_to_file ($path)
766
767Sets the C<log_cb> to log to a file (by appending), unbuffered.
768
769=item $ctx->log_to_path ($path)
770
771Same as C<< ->log_to_file >>, but opens the file for each message. This
772is much slower, but allows you to change/move/rename/delete the file at
773basically any time.
774
775=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message)) 893=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
776 894
777Replaces the formatting callback on the context (C<undef> restores the 895Replaces the formatting callback on the context (C<undef> restores the
778default formatter). 896default formatter).
779 897
780The callback is passed the (possibly fractional) timestamp, the original 898The callback is passed the (possibly fractional) timestamp, the original
781logging context, the (numeric) logging level and the raw message string 899logging context, the (numeric) logging level and the raw message string
782and needs to return a formatted log message. In most cases this will be a 900and needs to return a formatted log message. In most cases this will be a
783string, but it could just as well be an array reference that just stores 901string, but it could just as well be an array reference that just stores
784the values. 902the values.
785 903
786If, for some reaosn, you want to use C<caller> to find out more baout the 904If, for some reason, you want to use C<caller> to find out more baout the
787logger then you should walk up the call stack until you are no longer 905logger then you should walk up the call stack until you are no longer
788inside the C<AnyEvent::Log> package. 906inside the C<AnyEvent::Log> package.
789 907
790Example: format just the raw message, with numeric log level in angle 908Example: format just the raw message, with numeric log level in angle
791brackets. 909brackets.
… …
810 "$msg->[3]"; 928 "$msg->[3]";
811 929
812 0 930 0
813 }); 931 });
814 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
815=cut 962=cut
816 963
817sub log_cb { 964sub log_cb {
818 my ($ctx, $cb) = @_; 965 my ($ctx, $cb) = @_;
819 966
… …
822 969
823sub fmt_cb { 970sub fmt_cb {
824 my ($ctx, $cb) = @_; 971 my ($ctx, $cb) = @_;
825 972
826 $ctx->[4] = $cb; 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 });
827} 983}
828 984
829sub log_to_file { 985sub log_to_file {
830 my ($ctx, $path) = @_; 986 my ($ctx, $path) = @_;
831 987
… …
836 syswrite $fh, shift; 992 syswrite $fh, shift;
837 0 993 0
838 }); 994 });
839} 995}
840 996
841sub log_to_file { 997sub log_to_path {
842 my ($ctx, $path) = @_; 998 my ($ctx, $path) = @_;
843 999
844 $ctx->log_cb (sub { 1000 $ctx->log_cb (sub {
845 open my $fh, ">>", $path 1001 open my $fh, ">>", $path
846 or die "$path: $!"; 1002 or die "$path: $!";
… …
848 syswrite $fh, shift; 1004 syswrite $fh, shift;
849 0 1005 0
850 }); 1006 });
851} 1007}
852 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
853=back 1033=back
854 1034
855=head3 MESSAGE LOGGING 1035=head3 MESSAGE LOGGING
856 1036
857These methods allow you to log messages directly to a context, without 1037These methods allow you to log messages directly to a context, without
… …
871=cut 1051=cut
872 1052
873*log = \&AnyEvent::Log::_log; 1053*log = \&AnyEvent::Log::_log;
874*logger = \&AnyEvent::Log::_logger; 1054*logger = \&AnyEvent::Log::_logger;
875 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
8761; 12881;
877 1289
878=back
879
880=head1 EXAMPLES 1290=head1 EXAMPLES
881 1291
882This section shows some common configurations. 1292This section shows some common configurations, both as code, and as
1293C<PERL_ANYEVENT_LOG> string.
883 1294
884=over 4 1295=over 4
885 1296
886=item Setting the global logging level. 1297=item Setting the global logging level.
887 1298
888Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before 1299Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
889running your program, or modify the log level of the root context: 1300running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
1301the root context at runtime:
890 1302
891 PERL_ANYEVENT_VERBOSE=5 ./myprog 1303 PERL_ANYEVENT_VERBOSE=5 ./myprog
892 1304
1305 PERL_ANYEVENT_LOG=log=warn
1306
893 $AnyEvent::Log::FILTER->level ("warn"); 1307 $AnyEvent::Log::FILTER->level ("warn");
894 1308
895=item Append all messages to a file instead of sending them to STDERR. 1309=item Append all messages to a file instead of sending them to STDERR.
896 1310
897This is affected by the global logging level. 1311This is affected by the global logging level.
898 1312
899 $AnyEvent::Log::LOG->log_to_file ($path); (sub { 1313 $AnyEvent::Log::LOG->log_to_file ($path);
1314
1315 PERL_ANYEVENT_LOG=log=file=/some/path
900 1316
901=item Write all messages with priority C<error> and higher to a file. 1317=item Write all messages with priority C<error> and higher to a file.
902 1318
903This writes them only when the global logging level allows it, because 1319This writes them only when the global logging level allows it, because
904it is attached to the default context which is invoked I<after> global 1320it is attached to the default context which is invoked I<after> global
905filtering. 1321filtering.
906 1322
907 $AnyEvent::Log::FILTER->attach 1323 $AnyEvent::Log::FILTER->attach (
908 new AnyEvent::Log::Ctx log_to_file => $path); 1324 new AnyEvent::Log::Ctx log_to_file => $path);
1325
1326 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
909 1327
910This writes them regardless of the global logging level, because it is 1328This writes them regardless of the global logging level, because it is
911attached to the toplevel context, which receives all messages I<before> 1329attached to the toplevel context, which receives all messages I<before>
912the global filtering. 1330the global filtering.
913 1331
914 $AnyEvent::Log::COLLECT->attach ( 1332 $AnyEvent::Log::COLLECT->attach (
915 new AnyEvent::Log::Ctx log_to_file => $path); 1333 new AnyEvent::Log::Ctx log_to_file => $path);
916 1334
1335 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1336
917In both cases, messages are still written to STDERR. 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
918 1355
919=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). 1356=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
920 1357
921Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1358Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
922context - this simply circumvents the global filtering for trace messages. 1359context - this simply circumvents the global filtering for trace messages.
923 1360
924 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx; 1361 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
925 $debug->attach ($AnyEvent::Log::LOG); 1362 $debug->attach ($AnyEvent::Log::LOG);
1363
1364 PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
926 1365
927This of course works for any package, not just L<AnyEvent::Debug>, but 1366This of course works for any package, not just L<AnyEvent::Debug>, but
928assumes the log level for AnyEvent::Debug hasn't been changed from the 1367assumes the log level for AnyEvent::Debug hasn't been changed from the
929default. 1368default.
930 1369
… …
934 1373
935 Marc Lehmann <schmorp@schmorp.de> 1374 Marc Lehmann <schmorp@schmorp.de>
936 http://home.schmorp.de/ 1375 http://home.schmorp.de/
937 1376
938=cut 1377=cut
1378

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines