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.28 by root, Thu Aug 25 00:08:10 2011 UTC vs.
Revision 1.40 by root, Fri Aug 26 16:18:01 2011 UTC

… …
32 32
33 # send all critical and higher priority messages to syslog, 33 # send all critical and higher priority messages to syslog,
34 # regardless of (most) other settings 34 # regardless of (most) other settings
35 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx 35 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
36 level => "critical", 36 level => "critical",
37 log_to_syslog => 0, 37 log_to_syslog => "user",
38 ); 38 );
39 39
40=head1 DESCRIPTION 40=head1 DESCRIPTION
41 41
42This module implements a relatively simple "logging framework". It doesn't 42This module implements a relatively simple "logging framework". It doesn't
… …
49will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number 49will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
50before starting your program, or change the logging level at runtime with 50before starting your program, or change the logging level at runtime with
51something like: 51something like:
52 52
53 use AnyEvent::Log; 53 use AnyEvent::Log;
54 AnyEvent::Log::FILTER->level ("info"); 54 $AnyEvent::Log::FILTER->level ("info");
55 55
56The design goal behind this module was to keep it simple (and small), 56The design goal behind this module was to keep it simple (and small),
57but make it powerful enough to be potentially useful for any module, and 57but make it powerful enough to be potentially useful for any module, and
58extensive enough for the most common tasks, such as logging to multiple 58extensive enough for the most common tasks, such as logging to multiple
59targets, or being able to log into a database. 59targets, or being able to log into a database.
60 60
61The module is also usable before AnyEvent itself is initialised, in which
62case some of the functionality might be reduced.
63
61The amount of documentation might indicate otherwise, but the module is 64The amount of documentation might indicate otherwise, but the runtime part
62still just below 300 lines of code. 65of the module is still just below 300 lines of code.
63 66
64=head1 LOGGING LEVELS 67=head1 LOGGING LEVELS
65 68
66Logging levels in this module range from C<1> (highest priority) to C<9> 69Logging levels in this module range from C<1> (highest priority) to C<9>
67(lowest priority). Note that the lowest numerical value is the highest 70(lowest priority). Note that the lowest numerical value is the highest
… …
108 111
109use Carp (); 112use Carp ();
110use POSIX (); 113use POSIX ();
111 114
112use AnyEvent (); BEGIN { AnyEvent::common_sense } 115use AnyEvent (); BEGIN { AnyEvent::common_sense }
113use AnyEvent::Util (); 116#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
114 117
115our $VERSION = $AnyEvent::VERSION; 118our $VERSION = $AnyEvent::VERSION;
116 119
117our ($COLLECT, $FILTER, $LOG); 120our ($COLLECT, $FILTER, $LOG);
118 121
… …
203 info => 7, 206 info => 7,
204 debug => 8, 207 debug => 8,
205 trace => 9, 208 trace => 9,
206); 209);
207 210
208sub now () { time } 211our $TIME_EXACT;
212
213sub exact_time($) {
214 $TIME_EXACT = shift;
215 *_ts = $AnyEvent::MODEL
216 ? $TIME_EXACT ? \&AE::now : \&AE::time
217 : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
218}
219
220BEGIN {
221 exact_time 0;
222}
209 223
210AnyEvent::post_detect { 224AnyEvent::post_detect {
211 *now = \&AE::now; 225 exact_time $TIME_EXACT;
212}; 226};
213 227
214our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 228our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
215 229
216# time, ctx, level, msg 230# time, ctx, level, msg
… …
249 # now get raw message, unless we have it already 263 # now get raw message, unless we have it already
250 unless ($now) { 264 unless ($now) {
251 $format = $format->() if ref $format; 265 $format = $format->() if ref $format;
252 $format = sprintf $format, @args if @args; 266 $format = sprintf $format, @args if @args;
253 $format =~ s/\n$//; 267 $format =~ s/\n$//;
254 $now = AE::now; 268 $now = _ts;
255 }; 269 };
256 270
257 # format msg 271 # format msg
258 my $str = $ctx->[4] 272 my $str = $ctx->[4]
259 ? $ctx->[4]($now, $_[0], $level, $format) 273 ? $ctx->[4]($now, $_[0], $level, $format)
… …
354 368
355 $LOGGER{$logger+0} = $logger; 369 $LOGGER{$logger+0} = $logger;
356 370
357 _reassess $logger+0; 371 _reassess $logger+0;
358 372
373 require AnyEvent::Util;
359 my $guard = AnyEvent::Util::guard { 374 my $guard = AnyEvent::Util::guard (sub {
360 # "clean up" 375 # "clean up"
361 delete $LOGGER{$logger+0}; 376 delete $LOGGER{$logger+0};
362 }; 377 });
363 378
364 sub { 379 sub {
365 $guard if 0; # keep guard alive, but don't cause runtime overhead 380 $guard if 0; # keep guard alive, but don't cause runtime overhead
366 381
367 _log $ctx, $level, @_ 382 _log $ctx, $level, @_
… …
372sub logger($;$) { 387sub logger($;$) {
373 _logger 388 _logger
374 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 389 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
375 @_ 390 @_
376} 391}
392
393=item AnyEvent::Log::exact_time $on
394
395By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
396eventloop time, for the log timestamps. After calling this function with a
397true value it will instead resort to C<AE::time>, i.e. fetch the current
398time on each log message. This only makes a difference for event loops
399that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
400
401This setting can be changed at any time by calling this function.
402
403Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
404initialised, this switch will also decide whether to use C<CORE::time> or
405C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
406available.
377 407
378=back 408=back
379 409
380=head1 LOGGING CONTEXTS 410=head1 LOGGING CONTEXTS
381 411
… …
513 } 543 }
514 544
515 @$_ = ($_->[0], (1 << 10) - 1 - 1) 545 @$_ = ($_->[0], (1 << 10) - 1 - 1)
516 for $LOG, $FILTER, $COLLECT; 546 for $LOG, $FILTER, $COLLECT;
517 547
518 $LOG->slaves; 548 #$LOG->slaves;
519 $LOG->title ('$AnyEvent::Log::LOG'); 549 $LOG->title ('$AnyEvent::Log::LOG');
520 $LOG->log_to_warn; 550 $LOG->log_to_warn;
521 551
522 $FILTER->slaves ($LOG); 552 $FILTER->slaves ($LOG);
523 $FILTER->title ('$AnyEvent::Log::FILTER'); 553 $FILTER->title ('$AnyEvent::Log::FILTER');
… …
834 864
835Needless(?) to say, if you do not want to be bitten by some evil person 865Needless(?) to say, if you do not want to be bitten by some evil person
836calling C<chdir>, the path should be absolute. Doesn't help with 866calling C<chdir>, the path should be absolute. Doesn't help with
837C<chroot>, but hey... 867C<chroot>, but hey...
838 868
839=item $ctx->log_to_syslog ([$log_flags]) 869=item $ctx->log_to_syslog ([$facility])
840 870
841Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all 871Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
842the others in the obvious way. If specified, then the C<$log_flags> are 872all the others in the obvious way. If specified, then the C<$facility> is
843simply or'ed onto the priority argument and can contain any C<LOG_xxx> 873used as the facility (C<user>, C<auth>, C<local0> and so on). The default
844flags valid for Sys::Syslog::syslog, except for the priority levels. 874facility is C<user>.
845 875
846Note that this function also sets a C<fmt_cb> - the logging part requires 876Note that this function also sets a C<fmt_cb> - the logging part requires
847an array reference with [$level, $str] as input. 877an array reference with [$level, $str] as input.
848 878
849=cut 879=cut
… …
892 0 922 0
893 }); 923 });
894} 924}
895 925
896sub log_to_syslog { 926sub log_to_syslog {
897 my ($ctx, $flags) = @_; 927 my ($ctx, $facility) = @_;
898 928
899 require Sys::Syslog; 929 require Sys::Syslog;
900 930
901 $ctx->fmt_cb (sub { 931 $ctx->fmt_cb (sub {
902 my $str = $_[3]; 932 my $str = $_[3];
903 $str =~ s/\n(?=.)/\n+ /g; 933 $str =~ s/\n(?=.)/\n+ /g;
904 934
905 [$_[2], "($_[1][0]) $str"] 935 [$_[2], "($_[1][0]) $str"]
906 }); 936 });
907 937
938 $facility ||= "user";
939
908 $ctx->log_cb (sub { 940 $ctx->log_cb (sub {
909 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8; 941 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
910 942
911 Sys::Syslog::syslog ($flags | ($lvl - 1), $_) 943 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
912 for split /\n/, $_[0][1]; 944 for split /\n/, $_[0][1];
913 945
914 0 946 0
915 }); 947 });
916} 948}
… …
1012Configures the context to log to a file with the given path. Works like 1044Configures the context to log to a file with the given path. Works like
1013C<log_to_path>. 1045C<log_to_path>.
1014 1046
1015=item C<syslog> or C<syslog=>I<expr> 1047=item C<syslog> or C<syslog=>I<expr>
1016 1048
1017Configured the context to log to syslog. If I<expr> is given, then it is 1049Configures the context to log to syslog. If I<expr> is given, then it is
1018evaluated in the L<Sys::Syslog> package, so you could use: 1050evaluated in the L<Sys::Syslog> package, so you could use:
1019 1051
1020 log=syslog=LOG_LOCAL0 1052 log=syslog=LOG_LOCAL0
1021 1053
1022=item C<nolog> 1054=item C<nolog>
… …
1064 filter=warn 1096 filter=warn
1065 1097
1066 # or, more verbose 1098 # or, more verbose
1067 filter=only,level,warn 1099 filter=only,level,warn
1068 1100
1069=item C<1>..C<9>, a logging level name (C<error>, C<debug> etc.) 1101=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
1070 1102
1071A numeric loglevel or the name of a loglevel will be interpreted according 1103A numeric loglevel or the name of a loglevel will be interpreted according
1072to the most recent C<only>, C<except> or C<level> directive. By default, 1104to the most recent C<only>, C<except> or C<level> directive. By default,
1073specifying a logging level enables that and any higher priority messages. 1105specifying a logging level enables that and any higher priority messages.
1074 1106
1075=item C<+>I<context> 1107=item C<+>I<context>
1076 1108
1077Adds/attaches the named context as slave to the context. 1109Attaches the named context as slave to the context.
1078 1110
1079=item C<+> 1111=item C<+>
1080 1112
1081A line C<+> clears the slave list form the context. Anonymous (C<%name>) 1113A line C<+> detaches all contexts, i.e. clears the slave list from the
1082contexts have no slaves by default, but package contexts have the parent 1114context. Anonymous (C<%name>) contexts have no attached slaves by default,
1083context as slave by default. 1115but package contexts have the parent context as slave by default.
1084 1116
1085Example: log messages from My::Module to a file, do not send them to the 1117Example: log messages from My::Module to a file, do not send them to the
1086default log collector. 1118default log collector.
1087 1119
1088 My::Module=+,file=/tmp/mymodulelog 1120 My::Module=+,file=/tmp/mymodulelog
1089 1121
1090=back 1122=back
1091 1123
1124Any character can be escaped by prefixing it with a C<\> (backslash), as
1125usual, so to log to a file containing a comma, colon, backslash and some
1126spaces in the filename, you would do this:
1127
1128 PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
1129
1130Since whitespace (which includes newlines) is allowed, it is fine to
1131specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
1132
1133 PERL_ANYEVENT_LOG="
1134 filter=warn
1135 AnyEvent::Debug=+%trace
1136 %trace=only,trace,+log
1137 " myprog
1138
1139Also, in the unlikely case when you want to concatenate specifications,
1140use whitespace as separator, as C<::> will be interpreted as part of a
1141module name, an empty spec with two separators:
1142
1143 PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
1144
1092=cut 1145=cut
1093 1146
1094for (my $spec = $ENV{PERL_ANYEVENT_LOG}) { 1147for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1095 my %anon; 1148 my %anon;
1096 1149
1097 my $pkg = sub { 1150 my $pkg = sub {
1098 $_[0] eq "log" ? $LOG 1151 $_[0] eq "log" ? $LOG
1099 : $_[0] eq "filter" ? $FILTER 1152 : $_[0] eq "filter" ? $FILTER
1100 : $_[0] eq "collect" ? $COLLECT 1153 : $_[0] eq "collect" ? $COLLECT
1101 : $_[0] =~ /^%(.+)$/ && $anon{$1} ||= ctx undef 1154 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef)
1102 : $_[0] =~ /^(.*?)(?:::)?$/ && ctx "$1" # egad :/ 1155 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1156 : die # never reached?
1103 }; 1157 };
1104 1158
1159 /\G[[:space:]]+/gc; # skip initial whitespace
1160
1105 while (/\G((?:[^:=]+|::|\\.)+)=/gc) { 1161 while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
1106 my $ctx = $pkg->($1); 1162 my $ctx = $pkg->($1);
1107 my $level = "level"; 1163 my $level = "level";
1108 1164
1109 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) { 1165 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1110 for ("$1") { 1166 for ("$1") {
1111 if ($_ eq "stderr" ) { $ctx->log_to_warn; 1167 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1112 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1"); 1168 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1113 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1"); 1169 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1114 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog (eval "package Sys::Syslog; $1"); 1170 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ($1);
1115 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef); 1171 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1116 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1")); 1172 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1117 } elsif ($_ eq "+" ) { $ctx->slaves; 1173 } elsif ($_ eq "+" ) { $ctx->slaves;
1118 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0); 1174 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1119 } elsif ($_ eq "all" ) { $ctx->level ("all"); 1175 } elsif ($_ eq "all" ) { $ctx->level ("all");
… …
1127 } 1183 }
1128 1184
1129 /\G,/gc or last; 1185 /\G,/gc or last;
1130 } 1186 }
1131 1187
1132 /\G[:[:space:]]/gc or last; 1188 /\G[:[:space:]]+/gc or last;
1133 } 1189 }
1190
1191 /\G[[:space:]]+/gc; # skip trailing whitespace
1134 1192
1135 if (/\G(.+)/g) { 1193 if (/\G(.+)/g) {
1136 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n"; 1194 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1137 } 1195 }
1138} 1196}

Diff Legend

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