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.41 by root, Thu Sep 1 04:07:18 2011 UTC vs.
Revision 1.47 by root, Sun Mar 11 20:39:10 2012 UTC

… …
6 6
7Simple uses: 7Simple uses:
8 8
9 use AnyEvent; 9 use AnyEvent;
10 10
11 AE::log debug => "hit my knee"; 11 AE::log trace => "going to call function abc";
12 AE::log warn => "it's a bit too hot"; 12 AE::log debug => "the function returned 3";
13 AE::log error => "the flag was false!"; 13 AE::log info => "file soandso successfully deleted";
14 AE::log fatal => "the bit toggled! run!"; # never returns 14 AE::log note => "wanted to create config, but config was alraedy 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
15 20
16 # available log levels in order: 21Log level overview:
17 # fatal alert critical error warn note info debug trace
18 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
19"Complex" uses (for speed sensitive code): 34"Complex" uses (for speed sensitive code, e.g. trace/debug messages):
20 35
21 use AnyEvent::Log; 36 use AnyEvent::Log;
22 37
23 my $tracer = AnyEvent::Log::logger trace => \$my $trace; 38 my $tracer = AnyEvent::Log::logger trace => \$my $trace;
24 39
… …
75numerical value". 90numerical value".
76 91
77Instead 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:
78 93
79 LVL NAME SYSLOG PERL NOTE 94 LVL NAME SYSLOG PERL NOTE
80 1 fatal emerg exit aborts program! 95 1 fatal emerg exit system unusable, aborts program!
81 2 alert 96 2 alert failure in primary system
82 3 critical crit 97 3 critical crit failure in backup system
83 4 error err die 98 4 error err die non-urgent program errors, a bug
84 5 warn warning 99 5 warn warning possible problem, not necessarily error
85 6 note notice 100 6 note notice unusual conditions
86 7 info 101 7 info normal messages, no action required
87 8 debug 102 8 debug debugging messages for development
88 9 trace 103 9 trace copious tracing output
89 104
90As 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
91is 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)
92and the third one the "perl" name, suggesting (only!) that you log C<die> 107and the third one the "perl" name, suggesting (only!) that you log C<die>
93messages at C<error> priority. 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
112the program (admins, staff), and are the only logged to STDERR by
113default. Levels 4..6 are meant for users and developers alike, while
114levels 7..9 are usually meant for developers.
94 115
95You can normally only log a single message at highest priority level 116You can normally only log a single message at highest priority level
96(C<1>, C<fatal>), because logging a fatal message will also quit the 117(C<1>, C<fatal>), because logging a fatal message will also quit the
97program - so use it sparingly :) 118program - so use it sparingly :)
98 119
… …
113package AnyEvent::Log; 134package AnyEvent::Log;
114 135
115use Carp (); 136use Carp ();
116use POSIX (); 137use POSIX ();
117 138
139# layout of a context
140# 0 1 2 3 4, 5
141# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
142
118use AnyEvent (); BEGIN { AnyEvent::common_sense } 143use AnyEvent (); BEGIN { AnyEvent::common_sense }
119#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log 144#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
120 145
121our $VERSION = $AnyEvent::VERSION; 146our $VERSION = $AnyEvent::VERSION;
122 147
… …
166 191
167Last 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
168supposed 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
169actually 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
170message in the first place. 195message in the first place.
196
197This function takes care of saving and restoring C<$!> and C<$@>, so you
198don't have to.
171 199
172Whether 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
173and the caller's package. The return value can be used to ensure that 201and the caller's package. The return value can be used to ensure that
174messages or not "lost" - for example, when L<AnyEvent::Debug> detects a 202messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
175runtime error it tries to log it at C<die> level, but if that message is 203runtime error it tries to log it at C<die> level, but if that message is
… …
243 } 271 }
244 272
245 join "", @res 273 join "", @res
246} 274}
247 275
276sub fatal_exit() {
277 exit 1;
278}
279
248sub _log { 280sub _log {
249 my ($ctx, $level, $format, @args) = @_; 281 my ($ctx, $level, $format, @args) = @_;
250 282
251 $level = $level > 0 && $level <= 9 283 $level = $level > 0 && $level <= 9
252 ? $level+0 284 ? $level+0
253 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 285 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
254 286
255 my $mask = 1 << $level; 287 my $mask = 1 << $level;
256 288
257 my ($success, %seen, @ctx, $now, $fmt); 289 my ($success, %seen, @ctx, $now, @fmt);
258 290
259 do 291 do
260 { 292 {
261 # skip if masked 293 # if !ref, then it's a level number
294 if (!ref $ctx) {
295 $level = $ctx;
262 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
263 if ($ctx->[3]) { 306 if ($ctx->[3]) {
264 # logging target found 307 # logging target found
308
309 local ($!, $@);
265 310
266 # now get raw message, unless we have it already 311 # now get raw message, unless we have it already
267 unless ($now) { 312 unless ($now) {
268 $format = $format->() if ref $format; 313 $format = $format->() if ref $format;
269 $format = sprintf $format, @args if @args; 314 $format = sprintf $format, @args if @args;
… …
272 }; 317 };
273 318
274 # format msg 319 # format msg
275 my $str = $ctx->[4] 320 my $str = $ctx->[4]
276 ? $ctx->[4]($now, $_[0], $level, $format) 321 ? $ctx->[4]($now, $_[0], $level, $format)
277 : ($fmt ||= _format $now, $_[0], $level, $format); 322 : ($fmt[$level] ||= _format $now, $_[0], $level, $format);
278 323
279 $success = 1; 324 $success = 1;
280 325
281 $ctx->[3]($str) 326 $ctx->[3]($str)
282 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 327 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
… …
285 } 330 }
286 } 331 }
287 } 332 }
288 while $ctx = pop @ctx; 333 while $ctx = pop @ctx;
289 334
290 exit 1 if $level <= 1; 335 fatal_exit if $level <= 1;
291 336
292 $success 337 $success
293} 338}
294 339
295sub log($$;@) { 340sub log($$;@) {
296 _log 341 _log
297 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 342 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
298 @_; 343 @_;
299} 344}
300 345
301*AnyEvent::log = *AE::log = \&log;
302
303=item $logger = AnyEvent::Log::logger $level[, \$enabled] 346=item $logger = AnyEvent::Log::logger $level[, \$enabled]
304 347
305Creates a code reference that, when called, acts as if the 348Creates a code reference that, when called, acts as if the
306C<AnyEvent::Log::log> function was called at this point with the given 349C<AnyEvent::Log::log> function was called at this point with the given
307level. 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
… …
371 414
372 $LOGGER{$logger+0} = $logger; 415 $LOGGER{$logger+0} = $logger;
373 416
374 _reassess $logger+0; 417 _reassess $logger+0;
375 418
376 require AnyEvent::Util; 419 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
377 my $guard = AnyEvent::Util::guard (sub { 420 my $guard = AnyEvent::Util::guard (sub {
378 # "clean up" 421 # "clean up"
379 delete $LOGGER{$logger+0}; 422 delete $LOGGER{$logger+0};
380 }); 423 });
381 424
… …
534This 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
535configuration, reset all contexts. 578configuration, reset all contexts.
536 579
537=cut 580=cut
538 581
582our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
583$AnyEvent::VERBOSE = 9;
584
539sub reset { 585sub reset {
540 # hard to kill complex data structures 586 # hard to kill complex data structures
541 # we "recreate" all package loggers and reset the hierarchy 587 # we "recreate" all package loggers and reset the hierarchy
542 while (my ($k, $v) = each %CTX) { 588 while (my ($k, $v) = each %CTX) {
543 @$v = ($k, (1 << 10) - 1 - 1, { }); 589 @$v = ($k, (1 << 10) - 1 - 1, { });
… …
552 $LOG->title ('$AnyEvent::Log::LOG'); 598 $LOG->title ('$AnyEvent::Log::LOG');
553 $LOG->log_to_warn; 599 $LOG->log_to_warn;
554 600
555 $FILTER->slaves ($LOG); 601 $FILTER->slaves ($LOG);
556 $FILTER->title ('$AnyEvent::Log::FILTER'); 602 $FILTER->title ('$AnyEvent::Log::FILTER');
557 $FILTER->level ($AnyEvent::VERBOSE); 603 $FILTER->level ($ORIG_VERBOSE);
558 604
559 $COLLECT->slaves ($FILTER); 605 $COLLECT->slaves ($FILTER);
560 $COLLECT->title ('$AnyEvent::Log::COLLECT'); 606 $COLLECT->title ('$AnyEvent::Log::COLLECT');
561 607
562 _reassess; 608 _reassess;
563} 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;
564 618
565# create the default logger contexts 619# create the default logger contexts
566$LOG = ctx undef; 620$LOG = ctx undef;
567$FILTER = ctx undef; 621$FILTER = ctx undef;
568$COLLECT = ctx undef; 622$COLLECT = ctx undef;
… …
577package AnyEvent::Log::COLLECT; 631package AnyEvent::Log::COLLECT;
578package AE::Log::COLLECT; 632package AE::Log::COLLECT;
579 633
580package AnyEvent::Log::Ctx; 634package AnyEvent::Log::Ctx;
581 635
582# 0 1 2 3 4
583# [$title, $level, %$slaves, &$logcb, &$fmtcb]
584
585=item $ctx = new AnyEvent::Log::Ctx methodname => param... 636=item $ctx = new AnyEvent::Log::Ctx methodname => param...
586 637
587This is a convenience constructor that makes it simpler to construct 638This is a convenience constructor that makes it simpler to construct
588anonymous logging contexts. 639anonymous logging contexts.
589 640
… …
676 727
677=item $ctx->disable ($level[, $level...]) 728=item $ctx->disable ($level[, $level...])
678 729
679Disables logging for the given levels, leaving all others unchanged. 730Disables logging for the given levels, leaving all others unchanged.
680 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
681=cut 754=cut
682 755
683sub _lvl_lst { 756sub _lvl_lst {
684 map { 757 map {
685 $_ > 0 && $_ <= 9 ? $_+0 758 $_ > 0 && $_ <= 9 ? $_+0
686 : $_ eq "all" ? (1 .. 9) 759 : $_ eq "all" ? (1 .. 9)
687 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 760 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
688 } @_ 761 } @_
689} 762}
690 763
764sub _lvl {
765 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
766}
767
691our $NOP_CB = sub { 0 }; 768our $NOP_CB = sub { 0 };
692 769
693sub levels { 770sub levels {
694 my $ctx = shift; 771 my $ctx = shift;
695 $ctx->[1] = 0; 772 $ctx->[1] = 0;
… …
698 AnyEvent::Log::_reassess; 775 AnyEvent::Log::_reassess;
699} 776}
700 777
701sub level { 778sub level {
702 my $ctx = shift; 779 my $ctx = shift;
703 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
704
705 $ctx->[1] = ((1 << $lvl) - 1) << 1; 780 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
706 AnyEvent::Log::_reassess; 781 AnyEvent::Log::_reassess;
707} 782}
708 783
709sub enable { 784sub enable {
710 my $ctx = shift; 785 my $ctx = shift;
… …
718 $ctx->[1] &= ~(1 << $_) 793 $ctx->[1] &= ~(1 << $_)
719 for &_lvl_lst; 794 for &_lvl_lst;
720 AnyEvent::Log::_reassess; 795 AnyEvent::Log::_reassess;
721} 796}
722 797
798sub cap {
799 my $ctx = shift;
800 $ctx->[5] = &_lvl;
801}
802
723=back 803=back
724 804
725=head3 SLAVE CONTEXTS 805=head3 SLAVE CONTEXTS
726 806
727The following methods attach and detach another logging context to a 807The following methods attach and detach another logging context to a
… …
1057=item C<nolog> 1137=item C<nolog>
1058 1138
1059Configures the context to not log anything by itself, which is the 1139Configures the context to not log anything by itself, which is the
1060default. Same as C<< $ctx->log_cb (undef) >>. 1140default. Same as C<< $ctx->log_cb (undef) >>.
1061 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
1062=item C<0> or C<off> 1148=item C<0> or C<off>
1063 1149
1064Sets the logging level of the context ot C<0>, i.e. all messages will be 1150Sets the logging level of the context to C<0>, i.e. all messages will be
1065filtered out. 1151filtered out.
1066 1152
1067=item C<all> 1153=item C<all>
1068 1154
1069Enables all logging levels, i.e. filtering will effectively be switched 1155Enables all logging levels, i.e. filtering will effectively be switched
… …
1111 1197
1112Attaches the named context as slave to the context. 1198Attaches the named context as slave to the context.
1113 1199
1114=item C<+> 1200=item C<+>
1115 1201
1116A line C<+> detaches all contexts, i.e. clears the slave list from the 1202A lone C<+> detaches all contexts, i.e. clears the slave list from the
1117context. Anonymous (C<%name>) contexts have no attached slaves by default, 1203context. Anonymous (C<%name>) contexts have no attached slaves by default,
1118but package contexts have the parent context as slave by default. 1204but package contexts have the parent context as slave by default.
1119 1205
1120Example: log messages from My::Module to a file, do not send them to the 1206Example: log messages from My::Module to a file, do not send them to the
1121default log collector. 1207default log collector.
… …
1152 1238
1153 my $pkg = sub { 1239 my $pkg = sub {
1154 $_[0] eq "log" ? $LOG 1240 $_[0] eq "log" ? $LOG
1155 : $_[0] eq "filter" ? $FILTER 1241 : $_[0] eq "filter" ? $FILTER
1156 : $_[0] eq "collect" ? $COLLECT 1242 : $_[0] eq "collect" ? $COLLECT
1157 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef) 1243 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1158 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/ 1244 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1159 : die # never reached? 1245 : die # never reached?
1160 }; 1246 };
1161 1247
1162 /\G[[:space:]]+/gc; # skip initial whitespace 1248 /\G[[:space:]]+/gc; # skip initial whitespace
… …
1168 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) { 1254 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1169 for ("$1") { 1255 for ("$1") {
1170 if ($_ eq "stderr" ) { $ctx->log_to_warn; 1256 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1171 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1"); 1257 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1172 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1"); 1258 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1173 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ($1); 1259 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1174 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef); 1260 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1261 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1175 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1")); 1262 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1176 } elsif ($_ eq "+" ) { $ctx->slaves; 1263 } elsif ($_ eq "+" ) { $ctx->slaves;
1177 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0); 1264 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1178 } elsif ($_ eq "all" ) { $ctx->level ("all"); 1265 } elsif ($_ eq "all" ) { $ctx->level ("all");
1179 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level"; 1266 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
… …
1231 1318
1232This writes them only when the global logging level allows it, because 1319This writes them only when the global logging level allows it, because
1233it 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
1234filtering. 1321filtering.
1235 1322
1236 $AnyEvent::Log::FILTER->attach 1323 $AnyEvent::Log::FILTER->attach (
1237 new AnyEvent::Log::Ctx log_to_file => $path); 1324 new AnyEvent::Log::Ctx log_to_file => $path);
1238 1325
1239 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path 1326 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
1240 1327
1241This writes them regardless of the global logging level, because it is 1328This writes them regardless of the global logging level, because it is
… …
1247 1334
1248 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger 1335 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1249 1336
1250In both cases, messages are still written to STDERR. 1337In both cases, messages are still written to STDERR.
1251 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
1252=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).
1253 1357
1254Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1358Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
1255context - this simply circumvents the global filtering for trace messages. 1359context - this simply circumvents the global filtering for trace messages.
1256 1360

Diff Legend

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