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.27 by root, Wed Aug 24 23:59:10 2011 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 debug => "hit my knee";
11 AE::log warn => "it's a bit too hot"; 12 AE::log warn => "it's a bit too hot";
12 AE::log error => "the flag was false!"; 13 AE::log error => "the flag was false!";
13 AE::log fatal => "the bit toggled! run!"; 14 AE::log fatal => "the bit toggled! run!"; # never returns
14 15
15 # "complex" use 16"Complex" uses (for speed sensitive code):
17
16 use AnyEvent::Log; 18 use AnyEvent::Log;
17 19
18 my $tracer = AnyEvent::Log::logger trace => \$my $trace; 20 my $tracer = AnyEvent::Log::logger trace => \$my $trace;
19 21
20 $tracer->("i am here") if $trace; 22 $tracer->("i am here") if $trace;
21 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; 23 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
22 24
23 # configuration 25Configuration (also look at the EXAMPLES section):
24 26
25 # set logging for the current package to errors and higher only 27 # set logging for the current package to errors and higher only
26 AnyEvent::Log::ctx->level ("error"); 28 AnyEvent::Log::ctx->level ("error");
27 29
28 # set logging globally to anything below debug 30 # set logging level to suppress anything below "notice"
29 $AnyEvent::Log::FILTER->level ("notice"); 31 $AnyEvent::Log::FILTER->level ("notice");
30 32
31 # see also EXAMPLES, below 33 # send all critical and higher priority messages to syslog,
34 # regardless of (most) other settings
35 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
36 level => "critical",
37 log_to_syslog => 0,
38 );
32 39
33=head1 DESCRIPTION 40=head1 DESCRIPTION
34 41
35This module implements a relatively simple "logging framework". It doesn't 42This module implements a relatively simple "logging framework". It doesn't
36attempt to be "the" logging solution or even "a" logging solution for 43attempt to be "the" logging solution or even "a" logging solution for
37AnyEvent - AnyEvent simply creates logging messages internally, and this 44AnyEvent - AnyEvent simply creates logging messages internally, and this
38module more or less exposes the mechanism, with some extra spiff to allow 45module more or less exposes the mechanism, with some extra spiff to allow
39using it from other modules as well. 46using it from other modules as well.
40 47
41Remember that the default verbosity level is C<0>, so nothing will be 48Remember that the default verbosity level is C<0> (C<off>), so nothing
42logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number before 49will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
43starting your program, or change the logging level at runtime with 50before starting your program, or change the logging level at runtime with
44something like: 51something like:
45 52
46 use AnyEvent::Log; 53 use AnyEvent::Log;
47 AnyEvent::Log::FILTER->level ("info"); 54 AnyEvent::Log::FILTER->level ("info");
48 55
138 $ctx 145 $ctx
139} 146}
140 147
141=item AnyEvent::Log::log $level, $msg[, @args] 148=item AnyEvent::Log::log $level, $msg[, @args]
142 149
143Requests logging of the given C<$msg> with the given log level. 150Requests logging of the given C<$msg> with the given log level, and
151returns true if the message was logged I<somewhere>.
144 152
145For C<fatal> log levels, the program will abort. 153For C<fatal> log levels, the program will abort.
146 154
147If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the 155If 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. 156C<$msg> is interpreted as an sprintf format string.
154supposed to return the message. It will be called only then the message 162supposed 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 163actually gets logged, which is useful if it is costly to create the
156message in the first place. 164message in the first place.
157 165
158Whether the given message will be logged depends on the maximum log level 166Whether the given message will be logged depends on the maximum log level
159and the caller's package. 167and the caller's package. The return value can be used to ensure that
168messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
169runtime error it tries to log it at C<die> level, but if that message is
170lost it simply uses warn.
160 171
161Note that you can (and should) call this function as C<AnyEvent::log> or 172Note 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 173C<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 174need any additional functionality), as those functions will load the
164logging module on demand only. They are also much shorter to write. 175logging module on demand only. They are also much shorter to write.
224 ? $level+0 235 ? $level+0
225 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 236 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
226 237
227 my $mask = 1 << $level; 238 my $mask = 1 << $level;
228 239
229 my (%seen, @ctx, $now, $fmt); 240 my ($success, %seen, @ctx, $now, $fmt);
230 241
231 do 242 do
232 { 243 {
233 # skip if masked 244 # skip if masked
234 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) { 245 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
244 }; 255 };
245 256
246 # format msg 257 # format msg
247 my $str = $ctx->[4] 258 my $str = $ctx->[4]
248 ? $ctx->[4]($now, $_[0], $level, $format) 259 ? $ctx->[4]($now, $_[0], $level, $format)
249 : $fmt ||= _format $now, $_[0], $level, $format; 260 : ($fmt ||= _format $now, $_[0], $level, $format);
261
262 $success = 1;
250 263
251 $ctx->[3]($str) 264 $ctx->[3]($str)
252 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 265 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
253 } else { 266 } else {
254 push @ctx, values %{ $ctx->[2] }; # not masked - propagate 267 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
256 } 269 }
257 } 270 }
258 while $ctx = pop @ctx; 271 while $ctx = pop @ctx;
259 272
260 exit 1 if $level <= 1; 273 exit 1 if $level <= 1;
274
275 $success
261} 276}
262 277
263sub log($$;@) { 278sub log($$;@) {
264 _log 279 _log
265 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 280 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
269*AnyEvent::log = *AE::log = \&log; 284*AnyEvent::log = *AE::log = \&log;
270 285
271=item $logger = AnyEvent::Log::logger $level[, \$enabled] 286=item $logger = AnyEvent::Log::logger $level[, \$enabled]
272 287
273Creates a code reference that, when called, acts as if the 288Creates a code reference that, when called, acts as if the
274C<AnyEvent::Log::log> function was called at this point with the givne 289C<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 290level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
276the C<AnyEvent::Log::log> function: 291the C<AnyEvent::Log::log> function:
277 292
278 my $debug_log = AnyEvent::Log::logger "debug"; 293 my $debug_log = AnyEvent::Log::logger "debug";
279 294
488 503
489=cut 504=cut
490 505
491sub reset { 506sub reset {
492 # hard to kill complex data structures 507 # hard to kill complex data structures
493 # we recreate all package loggers and reset the hierarchy 508 # we "recreate" all package loggers and reset the hierarchy
494 while (my ($k, $v) = each %CTX) { 509 while (my ($k, $v) = each %CTX) {
495 @$v = ($k, (1 << 10) - 1 - 1, { }); 510 @$v = ($k, (1 << 10) - 1 - 1, { });
496 511
497 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log); 512 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
498 } 513 }
514
515 @$_ = ($_->[0], (1 << 10) - 1 - 1)
516 for $LOG, $FILTER, $COLLECT;
499 517
500 $LOG->slaves; 518 $LOG->slaves;
501 $LOG->title ('$AnyEvent::Log::LOG'); 519 $LOG->title ('$AnyEvent::Log::LOG');
502 $LOG->log_cb (sub { 520 $LOG->log_to_warn;
503 warn shift;
504 0
505 });
506 521
507 $FILTER->slaves ($LOG); 522 $FILTER->slaves ($LOG);
508 $FILTER->title ('$AnyEvent::Log::FILTER'); 523 $FILTER->title ('$AnyEvent::Log::FILTER');
509 $FILTER->level ($AnyEvent::VERBOSE); 524 $FILTER->level ($AnyEvent::VERBOSE);
510 525
511 $COLLECT->slaves ($FILTER); 526 $COLLECT->slaves ($FILTER);
512 $COLLECT->title ('$AnyEvent::Log::FILTER'); 527 $COLLECT->title ('$AnyEvent::Log::COLLECT');
513 528
514 _reassess; 529 _reassess;
515} 530}
516 531
517# create the default logger contexts 532# create the default logger contexts
731the logging (which consists of formatting the message and printing it or 746the logging (which consists of formatting the message and printing it or
732whatever it wants to do with it). 747whatever it wants to do with it).
733 748
734=over 4 749=over 4
735 750
736=item $ctx->log_cb ($cb->($str)) 751=item $ctx->log_cb ($cb->($str)
737 752
738Replaces the logging callback on the context (C<undef> disables the 753Replaces the logging callback on the context (C<undef> disables the
739logging callback). 754logging callback).
740 755
741The logging callback is responsible for handling formatted log messages 756The logging callback is responsible for handling formatted log messages
760your program. 775your program.
761 776
762 $ctx->levels ("debug", "trace"); 777 $ctx->levels ("debug", "trace");
763 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages 778 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
764 779
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)) 780=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
776 781
777Replaces the formatting callback on the context (C<undef> restores the 782Replaces the formatting callback on the context (C<undef> restores the
778default formatter). 783default formatter).
779 784
780The callback is passed the (possibly fractional) timestamp, the original 785The callback is passed the (possibly fractional) timestamp, the original
781logging context, the (numeric) logging level and the raw message string 786logging 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 787and 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 788string, but it could just as well be an array reference that just stores
784the values. 789the values.
785 790
786If, for some reaosn, you want to use C<caller> to find out more baout the 791If, 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 792logger then you should walk up the call stack until you are no longer
788inside the C<AnyEvent::Log> package. 793inside the C<AnyEvent::Log> package.
789 794
790Example: format just the raw message, with numeric log level in angle 795Example: format just the raw message, with numeric log level in angle
791brackets. 796brackets.
810 "$msg->[3]"; 815 "$msg->[3]";
811 816
812 0 817 0
813 }); 818 });
814 819
820=item $ctx->log_to_warn
821
822Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
823(usually this logs to STDERR).
824
825=item $ctx->log_to_file ($path)
826
827Sets the C<log_cb> to log to a file (by appending), unbuffered.
828
829=item $ctx->log_to_path ($path)
830
831Same as C<< ->log_to_file >>, but opens the file for each message. This
832is much slower, but allows you to change/move/rename/delete the file at
833basically any time.
834
835Needless(?) 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
837C<chroot>, but hey...
838
839=item $ctx->log_to_syslog ([$log_flags])
840
841Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all
842the others in the obvious way. If specified, then the C<$log_flags> are
843simply or'ed onto the priority argument and can contain any C<LOG_xxx>
844flags valid for Sys::Syslog::syslog, except for the priority levels.
845
846Note that this function also sets a C<fmt_cb> - the logging part requires
847an array reference with [$level, $str] as input.
848
815=cut 849=cut
816 850
817sub log_cb { 851sub log_cb {
818 my ($ctx, $cb) = @_; 852 my ($ctx, $cb) = @_;
819 853
822 856
823sub fmt_cb { 857sub fmt_cb {
824 my ($ctx, $cb) = @_; 858 my ($ctx, $cb) = @_;
825 859
826 $ctx->[4] = $cb; 860 $ctx->[4] = $cb;
861}
862
863sub log_to_warn {
864 my ($ctx, $path) = @_;
865
866 $ctx->log_cb (sub {
867 warn shift;
868 0
869 });
827} 870}
828 871
829sub log_to_file { 872sub log_to_file {
830 my ($ctx, $path) = @_; 873 my ($ctx, $path) = @_;
831 874
836 syswrite $fh, shift; 879 syswrite $fh, shift;
837 0 880 0
838 }); 881 });
839} 882}
840 883
841sub log_to_file { 884sub log_to_path {
842 my ($ctx, $path) = @_; 885 my ($ctx, $path) = @_;
843 886
844 $ctx->log_cb (sub { 887 $ctx->log_cb (sub {
845 open my $fh, ">>", $path 888 open my $fh, ">>", $path
846 or die "$path: $!"; 889 or die "$path: $!";
848 syswrite $fh, shift; 891 syswrite $fh, shift;
849 0 892 0
850 }); 893 });
851} 894}
852 895
896sub log_to_syslog {
897 my ($ctx, $flags) = @_;
898
899 require Sys::Syslog;
900
901 $ctx->fmt_cb (sub {
902 my $str = $_[3];
903 $str =~ s/\n(?=.)/\n+ /g;
904
905 [$_[2], "($_[1][0]) $str"]
906 });
907
908 $ctx->log_cb (sub {
909 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
910
911 Sys::Syslog::syslog ($flags | ($lvl - 1), $_)
912 for split /\n/, $_[0][1];
913
914 0
915 });
916}
917
853=back 918=back
854 919
855=head3 MESSAGE LOGGING 920=head3 MESSAGE LOGGING
856 921
857These methods allow you to log messages directly to a context, without 922These methods allow you to log messages directly to a context, without
871=cut 936=cut
872 937
873*log = \&AnyEvent::Log::_log; 938*log = \&AnyEvent::Log::_log;
874*logger = \&AnyEvent::Log::_logger; 939*logger = \&AnyEvent::Log::_logger;
875 940
941=back
942
943=cut
944
945package AnyEvent::Log;
946
947=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
948
949Logging can also be configured by setting the environment variable
950C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
951
952The value consists of one or more logging context specifications separated
953by C<:> or whitespace. Each logging specification in turn starts with a
954context name, followed by C<=>, followed by zero or more comma-separated
955configuration directives, here are some examples:
956
957 # set default logging level
958 filter=warn
959
960 # log to file instead of to stderr
961 log=file=/tmp/mylog
962
963 # log to file in addition to stderr
964 log=+%file:%file=file=/tmp/mylog
965
966 # enable debug log messages, log warnings and above to syslog
967 filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
968
969 # log trace messages (only) from AnyEvent::Debug to file
970 AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
971
972A context name in the log specification can be any of the following:
973
974=over 4
975
976=item C<collect>, C<filter>, C<log>
977
978Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
979C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
980
981=item C<%name>
982
983Context names starting with a C<%> are anonymous contexts created when the
984name is first mentioned. The difference to package contexts is that by
985default they have no attached slaves.
986
987=item a perl package name
988
989Any other string references the logging context associated with the given
990Perl C<package>. In the unlikely case where you want to specify a package
991context that matches on of the other context name forms, you can add a
992C<::> to the package name to force interpretation as a package.
993
994=back
995
996The configuration specifications can be any number of the following:
997
998=over 4
999
1000=item C<stderr>
1001
1002Configures the context to use Perl's C<warn> function (which typically
1003logs to C<STDERR>). Works like C<log_to_warn>.
1004
1005=item C<file=>I<path>
1006
1007Configures the context to log to a file with the given path. Works like
1008C<log_to_file>.
1009
1010=item C<path=>I<path>
1011
1012Configures the context to log to a file with the given path. Works like
1013C<log_to_path>.
1014
1015=item C<syslog> or C<syslog=>I<expr>
1016
1017Configured 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:
1019
1020 log=syslog=LOG_LOCAL0
1021
1022=item C<nolog>
1023
1024Configures the context to not log anything by itself, which is the
1025default. Same as C<< $ctx->log_cb (undef) >>.
1026
1027=item C<0> or C<off>
1028
1029Sets the logging level of the context ot C<0>, i.e. all messages will be
1030filtered out.
1031
1032=item C<all>
1033
1034Enables all logging levels, i.e. filtering will effectively be switched
1035off (the default).
1036
1037=item C<only>
1038
1039Disables all logging levels, and changes the interpretation of following
1040level specifications to enable the specified level only.
1041
1042Example: only enable debug messages for a context.
1043
1044 context=only,debug
1045
1046=item C<except>
1047
1048Enables all logging levels, and changes the interpretation of following
1049level specifications to disable that level. Rarely used.
1050
1051Example: enable all logging levels except fatal and trace (this is rather
1052nonsensical).
1053
1054 filter=exept,fatal,trace
1055
1056=item C<level>
1057
1058Enables all logging levels, and changes the interpretation of following
1059level specifications to be "that level or any higher priority
1060message". This is the default.
1061
1062Example: log anything at or above warn level.
1063
1064 filter=warn
1065
1066 # or, more verbose
1067 filter=only,level,warn
1068
1069=item C<1>..C<9>, a logging level name (C<error>, C<debug> etc.)
1070
1071A 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,
1073specifying a logging level enables that and any higher priority messages.
1074
1075=item C<+>I<context>
1076
1077Adds/attaches the named context as slave to the context.
1078
1079=item C<+>
1080
1081A line C<+> clears the slave list form the context. Anonymous (C<%name>)
1082contexts have no slaves by default, but package contexts have the parent
1083context as slave by default.
1084
1085Example: log messages from My::Module to a file, do not send them to the
1086default log collector.
1087
1088 My::Module=+,file=/tmp/mymodulelog
1089
1090=back
1091
1092=cut
1093
1094for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1095 my %anon;
1096
1097 my $pkg = sub {
1098 $_[0] eq "log" ? $LOG
1099 : $_[0] eq "filter" ? $FILTER
1100 : $_[0] eq "collect" ? $COLLECT
1101 : $_[0] =~ /^%(.+)$/ && $anon{$1} ||= ctx undef
1102 : $_[0] =~ /^(.*?)(?:::)?$/ && ctx "$1" # egad :/
1103 };
1104
1105 while (/\G((?:[^:=]+|::|\\.)+)=/gc) {
1106 my $ctx = $pkg->($1);
1107 my $level = "level";
1108
1109 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1110 for ("$1") {
1111 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1112 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1113 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1114 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog (eval "package Sys::Syslog; $1");
1115 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1116 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1117 } elsif ($_ eq "+" ) { $ctx->slaves;
1118 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1119 } elsif ($_ eq "all" ) { $ctx->level ("all");
1120 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1121 } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
1122 } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
1123 } elsif (/^\d$/ ) { $ctx->$level ($_);
1124 } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
1125 } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
1126 }
1127 }
1128
1129 /\G,/gc or last;
1130 }
1131
1132 /\G[:[:space:]]/gc or last;
1133 }
1134
1135 if (/\G(.+)/g) {
1136 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1137 }
1138}
1139
8761; 11401;
877
878=back
879 1141
880=head1 EXAMPLES 1142=head1 EXAMPLES
881 1143
882This section shows some common configurations. 1144This section shows some common configurations.
883 1145

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines