… | |
… | |
133 | |
133 | |
134 | package AnyEvent::Log; |
134 | package AnyEvent::Log; |
135 | |
135 | |
136 | use Carp (); |
136 | use Carp (); |
137 | use POSIX (); |
137 | use POSIX (); |
|
|
138 | |
|
|
139 | # layout of a context |
|
|
140 | # 0 1 2 3 4, 5 |
|
|
141 | # [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap] |
138 | |
142 | |
139 | use AnyEvent (); BEGIN { AnyEvent::common_sense } |
143 | use AnyEvent (); BEGIN { AnyEvent::common_sense } |
140 | #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 |
141 | |
145 | |
142 | our $VERSION = $AnyEvent::VERSION; |
146 | our $VERSION = $AnyEvent::VERSION; |
… | |
… | |
277 | ? $level+0 |
281 | ? $level+0 |
278 | : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; |
282 | : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; |
279 | |
283 | |
280 | my $mask = 1 << $level; |
284 | my $mask = 1 << $level; |
281 | |
285 | |
282 | my ($success, %seen, @ctx, $now, $fmt); |
286 | my ($success, %seen, @ctx, $now, @fmt); |
283 | |
287 | |
284 | do |
288 | do |
285 | { |
289 | { |
286 | # skip if masked |
290 | # if !ref, then it's a level number |
|
|
291 | if (!ref $ctx) { |
|
|
292 | $level = $ctx; |
287 | if ($ctx->[1] & $mask && !$seen{$ctx+0}++) { |
293 | } elsif ($ctx->[1] & $mask and !$seen{$ctx+0}++) { |
|
|
294 | # logging/recursing into this context |
|
|
295 | |
|
|
296 | # level cap |
|
|
297 | if ($ctx->[5] > $level) { |
|
|
298 | push @ctx, $level; # restore level when going up in tree |
|
|
299 | $level = $ctx->[5]; |
|
|
300 | } |
|
|
301 | |
|
|
302 | # log if log cb |
288 | if ($ctx->[3]) { |
303 | if ($ctx->[3]) { |
289 | # logging target found |
304 | # logging target found |
290 | |
305 | |
291 | # now get raw message, unless we have it already |
306 | # now get raw message, unless we have it already |
292 | unless ($now) { |
307 | unless ($now) { |
… | |
… | |
297 | }; |
312 | }; |
298 | |
313 | |
299 | # format msg |
314 | # format msg |
300 | my $str = $ctx->[4] |
315 | my $str = $ctx->[4] |
301 | ? $ctx->[4]($now, $_[0], $level, $format) |
316 | ? $ctx->[4]($now, $_[0], $level, $format) |
302 | : ($fmt ||= _format $now, $_[0], $level, $format); |
317 | : ($fmt[$level] ||= _format $now, $_[0], $level, $format); |
303 | |
318 | |
304 | $success = 1; |
319 | $success = 1; |
305 | |
320 | |
306 | $ctx->[3]($str) |
321 | $ctx->[3]($str) |
307 | or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate |
322 | or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate |
… | |
… | |
611 | package AnyEvent::Log::COLLECT; |
626 | package AnyEvent::Log::COLLECT; |
612 | package AE::Log::COLLECT; |
627 | package AE::Log::COLLECT; |
613 | |
628 | |
614 | package AnyEvent::Log::Ctx; |
629 | package AnyEvent::Log::Ctx; |
615 | |
630 | |
616 | # 0 1 2 3 4 |
|
|
617 | # [$title, $level, %$slaves, &$logcb, &$fmtcb] |
|
|
618 | |
|
|
619 | =item $ctx = new AnyEvent::Log::Ctx methodname => param... |
631 | =item $ctx = new AnyEvent::Log::Ctx methodname => param... |
620 | |
632 | |
621 | This is a convenience constructor that makes it simpler to construct |
633 | This is a convenience constructor that makes it simpler to construct |
622 | anonymous logging contexts. |
634 | anonymous logging contexts. |
623 | |
635 | |
… | |
… | |
710 | |
722 | |
711 | =item $ctx->disable ($level[, $level...]) |
723 | =item $ctx->disable ($level[, $level...]) |
712 | |
724 | |
713 | Disables logging for the given levels, leaving all others unchanged. |
725 | Disables logging for the given levels, leaving all others unchanged. |
714 | |
726 | |
|
|
727 | =item $ctx->cap ($level) |
|
|
728 | |
|
|
729 | Caps the maximum priority to the given level, for all messages logged |
|
|
730 | to, or passing through, this context. That is, while this doesn't affect |
|
|
731 | whether a message is logged or passed on, the maximum priority of messages |
|
|
732 | will be limited to the specified level - messages with a higher priority |
|
|
733 | will be set to the specified priority. |
|
|
734 | |
|
|
735 | Another way to view this is that C<< ->level >> filters out messages with |
|
|
736 | a too low priority, while C<< ->cap >> modifies messages with a too high |
|
|
737 | priority. |
|
|
738 | |
|
|
739 | This is useful when different log targets have different interpretations |
|
|
740 | of priority. For example, for a specific command line program, a wrong |
|
|
741 | command line switch might well result in a C<fatal> log message, while the |
|
|
742 | same message, logged to syslog, is likely I<not> fatal to the system or |
|
|
743 | syslog facility as a whole, but more likely a mere C<error>. |
|
|
744 | |
|
|
745 | This can be modeled by having a stderr logger that logs messages "as-is" |
|
|
746 | and a syslog logger that logs messages with a level cap of, say, C<error>, |
|
|
747 | or, for truly system-critical components, actually C<critical>. |
|
|
748 | |
715 | =cut |
749 | =cut |
716 | |
750 | |
717 | sub _lvl_lst { |
751 | sub _lvl_lst { |
718 | map { |
752 | map { |
719 | $_ > 0 && $_ <= 9 ? $_+0 |
753 | $_ > 0 && $_ <= 9 ? $_+0 |
720 | : $_ eq "all" ? (1 .. 9) |
754 | : $_ eq "all" ? (1 .. 9) |
721 | : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" |
755 | : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" |
722 | } @_ |
756 | } @_ |
723 | } |
757 | } |
724 | |
758 | |
|
|
759 | sub _lvl { |
|
|
760 | $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1] |
|
|
761 | } |
|
|
762 | |
725 | our $NOP_CB = sub { 0 }; |
763 | our $NOP_CB = sub { 0 }; |
726 | |
764 | |
727 | sub levels { |
765 | sub levels { |
728 | my $ctx = shift; |
766 | my $ctx = shift; |
729 | $ctx->[1] = 0; |
767 | $ctx->[1] = 0; |
… | |
… | |
732 | AnyEvent::Log::_reassess; |
770 | AnyEvent::Log::_reassess; |
733 | } |
771 | } |
734 | |
772 | |
735 | sub level { |
773 | sub level { |
736 | my $ctx = shift; |
774 | my $ctx = shift; |
737 | my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]; |
|
|
738 | |
|
|
739 | $ctx->[1] = ((1 << $lvl) - 1) << 1; |
775 | $ctx->[1] = ((1 << &_lvl) - 1) << 1; |
740 | AnyEvent::Log::_reassess; |
776 | AnyEvent::Log::_reassess; |
741 | } |
777 | } |
742 | |
778 | |
743 | sub enable { |
779 | sub enable { |
744 | my $ctx = shift; |
780 | my $ctx = shift; |
… | |
… | |
752 | $ctx->[1] &= ~(1 << $_) |
788 | $ctx->[1] &= ~(1 << $_) |
753 | for &_lvl_lst; |
789 | for &_lvl_lst; |
754 | AnyEvent::Log::_reassess; |
790 | AnyEvent::Log::_reassess; |
755 | } |
791 | } |
756 | |
792 | |
|
|
793 | sub cap { |
|
|
794 | my $ctx = shift; |
|
|
795 | $ctx->[5] = &_lvl; |
|
|
796 | } |
|
|
797 | |
757 | =back |
798 | =back |
758 | |
799 | |
759 | =head3 SLAVE CONTEXTS |
800 | =head3 SLAVE CONTEXTS |
760 | |
801 | |
761 | The following methods attach and detach another logging context to a |
802 | The following methods attach and detach another logging context to a |
… | |
… | |
1091 | =item C<nolog> |
1132 | =item C<nolog> |
1092 | |
1133 | |
1093 | Configures the context to not log anything by itself, which is the |
1134 | Configures the context to not log anything by itself, which is the |
1094 | default. Same as C<< $ctx->log_cb (undef) >>. |
1135 | default. Same as C<< $ctx->log_cb (undef) >>. |
1095 | |
1136 | |
|
|
1137 | =item C<cap=>I<level> |
|
|
1138 | |
|
|
1139 | Caps logging messages entering this context at the given level, i.e. |
|
|
1140 | reduces the priority of messages with higher priority than this level. The |
|
|
1141 | default is C<0> (or C<off>), meaning the priority will not be touched. |
|
|
1142 | |
1096 | =item C<0> or C<off> |
1143 | =item C<0> or C<off> |
1097 | |
1144 | |
1098 | Sets the logging level of the context ot C<0>, i.e. all messages will be |
1145 | Sets the logging level of the context to C<0>, i.e. all messages will be |
1099 | filtered out. |
1146 | filtered out. |
1100 | |
1147 | |
1101 | =item C<all> |
1148 | =item C<all> |
1102 | |
1149 | |
1103 | Enables all logging levels, i.e. filtering will effectively be switched |
1150 | Enables all logging levels, i.e. filtering will effectively be switched |
… | |
… | |
1186 | |
1233 | |
1187 | my $pkg = sub { |
1234 | my $pkg = sub { |
1188 | $_[0] eq "log" ? $LOG |
1235 | $_[0] eq "log" ? $LOG |
1189 | : $_[0] eq "filter" ? $FILTER |
1236 | : $_[0] eq "filter" ? $FILTER |
1190 | : $_[0] eq "collect" ? $COLLECT |
1237 | : $_[0] eq "collect" ? $COLLECT |
1191 | : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef) |
1238 | : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx }) |
1192 | : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/ |
1239 | : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/ |
1193 | : die # never reached? |
1240 | : die # never reached? |
1194 | }; |
1241 | }; |
1195 | |
1242 | |
1196 | /\G[[:space:]]+/gc; # skip initial whitespace |
1243 | /\G[[:space:]]+/gc; # skip initial whitespace |
… | |
… | |
1202 | while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) { |
1249 | while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) { |
1203 | for ("$1") { |
1250 | for ("$1") { |
1204 | if ($_ eq "stderr" ) { $ctx->log_to_warn; |
1251 | if ($_ eq "stderr" ) { $ctx->log_to_warn; |
1205 | } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1"); |
1252 | } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1"); |
1206 | } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1"); |
1253 | } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1"); |
1207 | } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ($1); |
1254 | } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1"); |
1208 | } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef); |
1255 | } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef); |
|
|
1256 | } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1"); |
1209 | } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1")); |
1257 | } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1")); |
1210 | } elsif ($_ eq "+" ) { $ctx->slaves; |
1258 | } elsif ($_ eq "+" ) { $ctx->slaves; |
1211 | } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0); |
1259 | } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0); |
1212 | } elsif ($_ eq "all" ) { $ctx->level ("all"); |
1260 | } elsif ($_ eq "all" ) { $ctx->level ("all"); |
1213 | } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level"; |
1261 | } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level"; |
… | |
… | |
1281 | |
1329 | |
1282 | PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger |
1330 | PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger |
1283 | |
1331 | |
1284 | In both cases, messages are still written to STDERR. |
1332 | In both cases, messages are still written to STDERR. |
1285 | |
1333 | |
|
|
1334 | =item Additionally log all messages with C<warn> and higher priority to |
|
|
1335 | C<syslog>, but cap at C<error>. |
|
|
1336 | |
|
|
1337 | This logs all messages to the default log target, but also logs messages |
|
|
1338 | with priority C<warn> or higher (and not filtered otherwise) to syslog |
|
|
1339 | facility C<user>. Messages with priority higher than C<error> will be |
|
|
1340 | logged with level C<error>. |
|
|
1341 | |
|
|
1342 | $AnyEvent::Log::LOG->attach ( |
|
|
1343 | new AnyEvent::Log::Ctx |
|
|
1344 | level => "warn", |
|
|
1345 | cap => "error", |
|
|
1346 | syslog => "user", |
|
|
1347 | ); |
|
|
1348 | |
|
|
1349 | PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog |
|
|
1350 | |
1286 | =item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). |
1351 | =item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). |
1287 | |
1352 | |
1288 | Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> |
1353 | Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> |
1289 | context - this simply circumvents the global filtering for trace messages. |
1354 | context - this simply circumvents the global filtering for trace messages. |
1290 | |
1355 | |