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.20 by root, Sat Aug 20 22:27:07 2011 UTC vs.
Revision 1.44 by root, Mon Sep 26 11:32:19 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 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 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
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
42will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number 67will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
43before starting 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.
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.
81 115
82You can normally only log a single message at highest priority level 116You can normally only log a single message at highest priority level
83(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
84program - so use it sparingly :) 118program - so use it sparingly :)
85 119
101 135
102use Carp (); 136use Carp ();
103use POSIX (); 137use POSIX ();
104 138
105use AnyEvent (); BEGIN { AnyEvent::common_sense } 139use AnyEvent (); BEGIN { AnyEvent::common_sense }
106use AnyEvent::Util (); 140#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
107 141
108our $VERSION = $AnyEvent::VERSION; 142our $VERSION = $AnyEvent::VERSION;
109 143
110our ($COLLECT, $FILTER, $LOG); 144our ($COLLECT, $FILTER, $LOG);
111 145
138 $ctx 172 $ctx
139} 173}
140 174
141=item AnyEvent::Log::log $level, $msg[, @args] 175=item AnyEvent::Log::log $level, $msg[, @args]
142 176
143Requests logging of the given C<$msg> with the given log level. 177Requests logging of the given C<$msg> with the given log level, and
178returns true if the message was logged I<somewhere>.
144 179
145For C<fatal> log levels, the program will abort. 180For loglevel C<fatal>, the program will abort.
146 181
147If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the 182If 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. 183C<$msg> is interpreted as an sprintf format string.
149 184
150The C<$msg> should not end with C<\n>, but may if that is convenient for 185The C<$msg> should not end with C<\n>, but may if that is convenient for
154supposed to return the message. It will be called only then the message 189supposed 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 190actually gets logged, which is useful if it is costly to create the
156message in the first place. 191message in the first place.
157 192
158Whether the given message will be logged depends on the maximum log level 193Whether the given message will be logged depends on the maximum log level
159and the caller's package. 194and the caller's package. The return value can be used to ensure that
195messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
196runtime error it tries to log it at C<die> level, but if that message is
197lost it simply uses warn.
160 198
161Note that you can (and should) call this function as C<AnyEvent::log> or 199Note 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 200C<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 201need any additional functionality), as those functions will load the
164logging module on demand only. They are also much shorter to write. 202logging module on demand only. They are also much shorter to write.
192 info => 7, 230 info => 7,
193 debug => 8, 231 debug => 8,
194 trace => 9, 232 trace => 9,
195); 233);
196 234
197sub now () { time } 235our $TIME_EXACT;
236
237sub exact_time($) {
238 $TIME_EXACT = shift;
239 *_ts = $AnyEvent::MODEL
240 ? $TIME_EXACT ? \&AE::now : \&AE::time
241 : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
242}
243
244BEGIN {
245 exact_time 0;
246}
198 247
199AnyEvent::post_detect { 248AnyEvent::post_detect {
200 *now = \&AE::now; 249 exact_time $TIME_EXACT;
201}; 250};
202 251
203our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 252our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
204 253
205# time, ctx, level, msg 254# time, ctx, level, msg
215 } 264 }
216 265
217 join "", @res 266 join "", @res
218} 267}
219 268
269sub fatal_exit() {
270 exit 1;
271}
272
220sub _log { 273sub _log {
221 my ($ctx, $level, $format, @args) = @_; 274 my ($ctx, $level, $format, @args) = @_;
222 275
223 $level = $level > 0 && $level <= 9 276 $level = $level > 0 && $level <= 9
224 ? $level+0 277 ? $level+0
225 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 278 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
226 279
227 my $mask = 1 << $level; 280 my $mask = 1 << $level;
228 281
229 my (%seen, @ctx, $now, $fmt); 282 my ($success, %seen, @ctx, $now, $fmt);
230 283
231 do 284 do
232 { 285 {
233 # skip if masked 286 # skip if masked
234 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) { 287 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
238 # now get raw message, unless we have it already 291 # now get raw message, unless we have it already
239 unless ($now) { 292 unless ($now) {
240 $format = $format->() if ref $format; 293 $format = $format->() if ref $format;
241 $format = sprintf $format, @args if @args; 294 $format = sprintf $format, @args if @args;
242 $format =~ s/\n$//; 295 $format =~ s/\n$//;
243 $now = AE::now; 296 $now = _ts;
244 }; 297 };
245 298
246 # format msg 299 # format msg
247 my $str = $ctx->[4] 300 my $str = $ctx->[4]
248 ? $ctx->[4]($now, $_[0], $level, $format) 301 ? $ctx->[4]($now, $_[0], $level, $format)
249 : ($fmt ||= _format $now, $_[0], $level, $format); 302 : ($fmt ||= _format $now, $_[0], $level, $format);
250 303
304 $success = 1;
305
251 $ctx->[3]($str, $_[0], $level) 306 $ctx->[3]($str)
252 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 307 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
253 } else { 308 } else {
254 push @ctx, values %{ $ctx->[2] }; # not masked - propagate 309 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
255 } 310 }
256 } 311 }
257 } 312 }
258 while $ctx = pop @ctx; 313 while $ctx = pop @ctx;
259 314
260 exit 1 if $level <= 1; 315 fatal_exit if $level <= 1;
316
317 $success
261} 318}
262 319
263sub log($$;@) { 320sub log($$;@) {
264 _log 321 _log
265 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 322 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
266 @_; 323 @_;
267} 324}
268 325
269*AnyEvent::log = *AE::log = \&log;
270
271=item $logger = AnyEvent::Log::logger $level[, \$enabled] 326=item $logger = AnyEvent::Log::logger $level[, \$enabled]
272 327
273Creates a code reference that, when called, acts as if the 328Creates a code reference that, when called, acts as if the
274C<AnyEvent::Log::log> function was called at this point with the givne 329C<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 330level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
276the C<AnyEvent::Log::log> function: 331the C<AnyEvent::Log::log> function:
277 332
278 my $debug_log = AnyEvent::Log::logger "debug"; 333 my $debug_log = AnyEvent::Log::logger "debug";
279 334
339 394
340 $LOGGER{$logger+0} = $logger; 395 $LOGGER{$logger+0} = $logger;
341 396
342 _reassess $logger+0; 397 _reassess $logger+0;
343 398
399 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
344 my $guard = AnyEvent::Util::guard { 400 my $guard = AnyEvent::Util::guard (sub {
345 # "clean up" 401 # "clean up"
346 delete $LOGGER{$logger+0}; 402 delete $LOGGER{$logger+0};
347 }; 403 });
348 404
349 sub { 405 sub {
350 $guard if 0; # keep guard alive, but don't cause runtime overhead 406 $guard if 0; # keep guard alive, but don't cause runtime overhead
351 407
352 _log $ctx, $level, @_ 408 _log $ctx, $level, @_
357sub logger($;$) { 413sub logger($;$) {
358 _logger 414 _logger
359 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 415 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
360 @_ 416 @_
361} 417}
418
419=item AnyEvent::Log::exact_time $on
420
421By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
422eventloop time, for the log timestamps. After calling this function with a
423true value it will instead resort to C<AE::time>, i.e. fetch the current
424time on each log message. This only makes a difference for event loops
425that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
426
427This setting can be changed at any time by calling this function.
428
429Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
430initialised, this switch will also decide whether to use C<CORE::time> or
431C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
432available.
362 433
363=back 434=back
364 435
365=head1 LOGGING CONTEXTS 436=head1 LOGGING CONTEXTS
366 437
486This can be used to implement config-file (re-)loading: before loading a 557This can be used to implement config-file (re-)loading: before loading a
487configuration, reset all contexts. 558configuration, reset all contexts.
488 559
489=cut 560=cut
490 561
562our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
563$AnyEvent::VERBOSE = 9;
564
491sub reset { 565sub reset {
492 # hard to kill complex data structures 566 # hard to kill complex data structures
493 # we "recreate" all package loggers and reset the hierarchy 567 # we "recreate" all package loggers and reset the hierarchy
494 while (my ($k, $v) = each %CTX) { 568 while (my ($k, $v) = each %CTX) {
495 @$v = ($k, (1 << 10) - 1 - 1, { }); 569 @$v = ($k, (1 << 10) - 1 - 1, { });
498 } 572 }
499 573
500 @$_ = ($_->[0], (1 << 10) - 1 - 1) 574 @$_ = ($_->[0], (1 << 10) - 1 - 1)
501 for $LOG, $FILTER, $COLLECT; 575 for $LOG, $FILTER, $COLLECT;
502 576
503 $LOG->slaves; 577 #$LOG->slaves;
504 $LOG->title ('$AnyEvent::Log::LOG'); 578 $LOG->title ('$AnyEvent::Log::LOG');
505 $LOG->log_cb (sub { 579 $LOG->log_to_warn;
506 warn shift;
507 0
508 });
509 580
510 $FILTER->slaves ($LOG); 581 $FILTER->slaves ($LOG);
511 $FILTER->title ('$AnyEvent::Log::FILTER'); 582 $FILTER->title ('$AnyEvent::Log::FILTER');
512 $FILTER->level ($AnyEvent::VERBOSE); 583 $FILTER->level ($ORIG_VERBOSE);
513 584
514 $COLLECT->slaves ($FILTER); 585 $COLLECT->slaves ($FILTER);
515 $COLLECT->title ('$AnyEvent::Log::COLLECT'); 586 $COLLECT->title ('$AnyEvent::Log::COLLECT');
516 587
517 _reassess; 588 _reassess;
518} 589}
590
591# override AE::log/logger
592*AnyEvent::log = *AE::log = \&log;
593*AnyEvent::logger = *AE::logger = \&logger;
594
595# convert AnyEvent loggers to AnyEvent::Log loggers
596$_->[0] = ctx $_->[0] # convert "pkg" to "ctx"
597 for values %LOGGER;
519 598
520# create the default logger contexts 599# create the default logger contexts
521$LOG = ctx undef; 600$LOG = ctx undef;
522$FILTER = ctx undef; 601$FILTER = ctx undef;
523$COLLECT = ctx undef; 602$COLLECT = ctx undef;
734the logging (which consists of formatting the message and printing it or 813the logging (which consists of formatting the message and printing it or
735whatever it wants to do with it). 814whatever it wants to do with it).
736 815
737=over 4 816=over 4
738 817
739=item $ctx->log_cb ($cb->($str, $orig_ctx, $level)) 818=item $ctx->log_cb ($cb->($str)
740 819
741Replaces the logging callback on the context (C<undef> disables the 820Replaces the logging callback on the context (C<undef> disables the
742logging callback). 821logging callback).
743 822
744The logging callback is responsible for handling formatted log messages 823The logging callback is responsible for handling formatted log messages
745(see C<fmt_cb> below) - normally simple text strings that end with a 824(see C<fmt_cb> below) - normally simple text strings that end with a
746newline (and are possibly multiline themselves). In addition to the 825newline (and are possibly multiline themselves).
747message, which is often the only argument you need to look at, it is
748passed the numeric log level and originating context.
749 826
750It also has to return true iff it has consumed the log message, and false 827It also has to return true iff it has consumed the log message, and false
751if it hasn't. Consuming a message means that it will not be sent to any 828if it hasn't. Consuming a message means that it will not be sent to any
752slave context. When in doubt, return C<0> from your logging callback. 829slave context. When in doubt, return C<0> from your logging callback.
753 830
764"trace". The messages will still be generated, though, which can slow down 841"trace". The messages will still be generated, though, which can slow down
765your program. 842your program.
766 843
767 $ctx->levels ("debug", "trace"); 844 $ctx->levels ("debug", "trace");
768 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages 845 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
769
770=item $ctx->log_to_file ($path)
771
772Sets the C<log_cb> to log to a file (by appending), unbuffered.
773
774=item $ctx->log_to_path ($path)
775
776Same as C<< ->log_to_file >>, but opens the file for each message. This
777is much slower, but allows you to change/move/rename/delete the file at
778basically any time.
779
780=item $ctx->log_to_syslog ([$log_flags])
781
782Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all
783the others in the obvious way. If specified, then the C<$log_flags> are
784simply or'ed onto the priority argument and can contain any C<LOG_xxx>
785flags valid for Sys::Syslog::syslog, except for the priority levels.
786
787Note that the default logging format includes a verbose timestamp, which
788is not so suited for syslog, so a simpler C<fmt_cb> might be useful:
789
790 $ctx->log_to_syslog;
791 $ctx->fmt_cb (sub { "($_[1][0]) $_[3]" });
792 846
793=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message)) 847=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
794 848
795Replaces the formatting callback on the context (C<undef> restores the 849Replaces the formatting callback on the context (C<undef> restores the
796default formatter). 850default formatter).
799logging context, the (numeric) logging level and the raw message string 853logging context, the (numeric) logging level and the raw message string
800and needs to return a formatted log message. In most cases this will be a 854and needs to return a formatted log message. In most cases this will be a
801string, but it could just as well be an array reference that just stores 855string, but it could just as well be an array reference that just stores
802the values. 856the values.
803 857
804If, for some reaosn, you want to use C<caller> to find out more baout the 858If, for some reason, you want to use C<caller> to find out more baout the
805logger then you should walk up the call stack until you are no longer 859logger then you should walk up the call stack until you are no longer
806inside the C<AnyEvent::Log> package. 860inside the C<AnyEvent::Log> package.
807 861
808Example: format just the raw message, with numeric log level in angle 862Example: format just the raw message, with numeric log level in angle
809brackets. 863brackets.
828 "$msg->[3]"; 882 "$msg->[3]";
829 883
830 0 884 0
831 }); 885 });
832 886
887=item $ctx->log_to_warn
888
889Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
890(usually this logs to STDERR).
891
892=item $ctx->log_to_file ($path)
893
894Sets the C<log_cb> to log to a file (by appending), unbuffered.
895
896=item $ctx->log_to_path ($path)
897
898Same as C<< ->log_to_file >>, but opens the file for each message. This
899is much slower, but allows you to change/move/rename/delete the file at
900basically any time.
901
902Needless(?) to say, if you do not want to be bitten by some evil person
903calling C<chdir>, the path should be absolute. Doesn't help with
904C<chroot>, but hey...
905
906=item $ctx->log_to_syslog ([$facility])
907
908Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
909all the others in the obvious way. If specified, then the C<$facility> is
910used as the facility (C<user>, C<auth>, C<local0> and so on). The default
911facility is C<user>.
912
913Note that this function also sets a C<fmt_cb> - the logging part requires
914an array reference with [$level, $str] as input.
915
833=cut 916=cut
834 917
835sub log_cb { 918sub log_cb {
836 my ($ctx, $cb) = @_; 919 my ($ctx, $cb) = @_;
837 920
840 923
841sub fmt_cb { 924sub fmt_cb {
842 my ($ctx, $cb) = @_; 925 my ($ctx, $cb) = @_;
843 926
844 $ctx->[4] = $cb; 927 $ctx->[4] = $cb;
928}
929
930sub log_to_warn {
931 my ($ctx, $path) = @_;
932
933 $ctx->log_cb (sub {
934 warn shift;
935 0
936 });
845} 937}
846 938
847sub log_to_file { 939sub log_to_file {
848 my ($ctx, $path) = @_; 940 my ($ctx, $path) = @_;
849 941
854 syswrite $fh, shift; 946 syswrite $fh, shift;
855 0 947 0
856 }); 948 });
857} 949}
858 950
859sub log_to_file { 951sub log_to_path {
860 my ($ctx, $path) = @_; 952 my ($ctx, $path) = @_;
861 953
862 $ctx->log_cb (sub { 954 $ctx->log_cb (sub {
863 open my $fh, ">>", $path 955 open my $fh, ">>", $path
864 or die "$path: $!"; 956 or die "$path: $!";
867 0 959 0
868 }); 960 });
869} 961}
870 962
871sub log_to_syslog { 963sub log_to_syslog {
872 my ($ctx, $flags) = @_; 964 my ($ctx, $facility) = @_;
873 965
874 require Sys::Syslog; 966 require Sys::Syslog;
875 967
968 $ctx->fmt_cb (sub {
969 my $str = $_[3];
970 $str =~ s/\n(?=.)/\n+ /g;
971
972 [$_[2], "($_[1][0]) $str"]
973 });
974
975 $facility ||= "user";
976
876 $ctx->log_cb (sub { 977 $ctx->log_cb (sub {
877 my $lvl = $_[2] < 9 ? $_[2] : 8; 978 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
878 979
879 Sys::Syslog::syslog ($flags | ($lvl - 1), $_) 980 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
880 for split /\n/, shift; 981 for split /\n/, $_[0][1];
881 982
882 0 983 0
883 }); 984 });
884} 985}
885 986
904=cut 1005=cut
905 1006
906*log = \&AnyEvent::Log::_log; 1007*log = \&AnyEvent::Log::_log;
907*logger = \&AnyEvent::Log::_logger; 1008*logger = \&AnyEvent::Log::_logger;
908 1009
1010=back
1011
1012=cut
1013
1014package AnyEvent::Log;
1015
1016=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
1017
1018Logging can also be configured by setting the environment variable
1019C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
1020
1021The value consists of one or more logging context specifications separated
1022by C<:> or whitespace. Each logging specification in turn starts with a
1023context name, followed by C<=>, followed by zero or more comma-separated
1024configuration directives, here are some examples:
1025
1026 # set default logging level
1027 filter=warn
1028
1029 # log to file instead of to stderr
1030 log=file=/tmp/mylog
1031
1032 # log to file in addition to stderr
1033 log=+%file:%file=file=/tmp/mylog
1034
1035 # enable debug log messages, log warnings and above to syslog
1036 filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
1037
1038 # log trace messages (only) from AnyEvent::Debug to file
1039 AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
1040
1041A context name in the log specification can be any of the following:
1042
1043=over 4
1044
1045=item C<collect>, C<filter>, C<log>
1046
1047Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
1048C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
1049
1050=item C<%name>
1051
1052Context names starting with a C<%> are anonymous contexts created when the
1053name is first mentioned. The difference to package contexts is that by
1054default they have no attached slaves.
1055
1056=item a perl package name
1057
1058Any other string references the logging context associated with the given
1059Perl C<package>. In the unlikely case where you want to specify a package
1060context that matches on of the other context name forms, you can add a
1061C<::> to the package name to force interpretation as a package.
1062
1063=back
1064
1065The configuration specifications can be any number of the following:
1066
1067=over 4
1068
1069=item C<stderr>
1070
1071Configures the context to use Perl's C<warn> function (which typically
1072logs to C<STDERR>). Works like C<log_to_warn>.
1073
1074=item C<file=>I<path>
1075
1076Configures the context to log to a file with the given path. Works like
1077C<log_to_file>.
1078
1079=item C<path=>I<path>
1080
1081Configures the context to log to a file with the given path. Works like
1082C<log_to_path>.
1083
1084=item C<syslog> or C<syslog=>I<expr>
1085
1086Configures the context to log to syslog. If I<expr> is given, then it is
1087evaluated in the L<Sys::Syslog> package, so you could use:
1088
1089 log=syslog=LOG_LOCAL0
1090
1091=item C<nolog>
1092
1093Configures the context to not log anything by itself, which is the
1094default. Same as C<< $ctx->log_cb (undef) >>.
1095
1096=item C<0> or C<off>
1097
1098Sets the logging level of the context ot C<0>, i.e. all messages will be
1099filtered out.
1100
1101=item C<all>
1102
1103Enables all logging levels, i.e. filtering will effectively be switched
1104off (the default).
1105
1106=item C<only>
1107
1108Disables all logging levels, and changes the interpretation of following
1109level specifications to enable the specified level only.
1110
1111Example: only enable debug messages for a context.
1112
1113 context=only,debug
1114
1115=item C<except>
1116
1117Enables all logging levels, and changes the interpretation of following
1118level specifications to disable that level. Rarely used.
1119
1120Example: enable all logging levels except fatal and trace (this is rather
1121nonsensical).
1122
1123 filter=exept,fatal,trace
1124
1125=item C<level>
1126
1127Enables all logging levels, and changes the interpretation of following
1128level specifications to be "that level or any higher priority
1129message". This is the default.
1130
1131Example: log anything at or above warn level.
1132
1133 filter=warn
1134
1135 # or, more verbose
1136 filter=only,level,warn
1137
1138=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
1139
1140A numeric loglevel or the name of a loglevel will be interpreted according
1141to the most recent C<only>, C<except> or C<level> directive. By default,
1142specifying a logging level enables that and any higher priority messages.
1143
1144=item C<+>I<context>
1145
1146Attaches the named context as slave to the context.
1147
1148=item C<+>
1149
1150A line C<+> detaches all contexts, i.e. clears the slave list from the
1151context. Anonymous (C<%name>) contexts have no attached slaves by default,
1152but package contexts have the parent context as slave by default.
1153
1154Example: log messages from My::Module to a file, do not send them to the
1155default log collector.
1156
1157 My::Module=+,file=/tmp/mymodulelog
1158
1159=back
1160
1161Any character can be escaped by prefixing it with a C<\> (backslash), as
1162usual, so to log to a file containing a comma, colon, backslash and some
1163spaces in the filename, you would do this:
1164
1165 PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
1166
1167Since whitespace (which includes newlines) is allowed, it is fine to
1168specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
1169
1170 PERL_ANYEVENT_LOG="
1171 filter=warn
1172 AnyEvent::Debug=+%trace
1173 %trace=only,trace,+log
1174 " myprog
1175
1176Also, in the unlikely case when you want to concatenate specifications,
1177use whitespace as separator, as C<::> will be interpreted as part of a
1178module name, an empty spec with two separators:
1179
1180 PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
1181
1182=cut
1183
1184for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1185 my %anon;
1186
1187 my $pkg = sub {
1188 $_[0] eq "log" ? $LOG
1189 : $_[0] eq "filter" ? $FILTER
1190 : $_[0] eq "collect" ? $COLLECT
1191 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef)
1192 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1193 : die # never reached?
1194 };
1195
1196 /\G[[:space:]]+/gc; # skip initial whitespace
1197
1198 while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
1199 my $ctx = $pkg->($1);
1200 my $level = "level";
1201
1202 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1203 for ("$1") {
1204 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1205 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1206 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1207 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ($1);
1208 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1209 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1210 } elsif ($_ eq "+" ) { $ctx->slaves;
1211 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1212 } elsif ($_ eq "all" ) { $ctx->level ("all");
1213 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1214 } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
1215 } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
1216 } elsif (/^\d$/ ) { $ctx->$level ($_);
1217 } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
1218 } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
1219 }
1220 }
1221
1222 /\G,/gc or last;
1223 }
1224
1225 /\G[:[:space:]]+/gc or last;
1226 }
1227
1228 /\G[[:space:]]+/gc; # skip trailing whitespace
1229
1230 if (/\G(.+)/g) {
1231 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1232 }
1233}
1234
9091; 12351;
910 1236
911=back
912
913=head1 EXAMPLES 1237=head1 EXAMPLES
914 1238
915This section shows some common configurations. 1239This section shows some common configurations, both as code, and as
1240C<PERL_ANYEVENT_LOG> string.
916 1241
917=over 4 1242=over 4
918 1243
919=item Setting the global logging level. 1244=item Setting the global logging level.
920 1245
921Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before 1246Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
922running your program, or modify the log level of the root context: 1247running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
1248the root context at runtime:
923 1249
924 PERL_ANYEVENT_VERBOSE=5 ./myprog 1250 PERL_ANYEVENT_VERBOSE=5 ./myprog
925 1251
1252 PERL_ANYEVENT_LOG=log=warn
1253
926 $AnyEvent::Log::FILTER->level ("warn"); 1254 $AnyEvent::Log::FILTER->level ("warn");
927 1255
928=item Append all messages to a file instead of sending them to STDERR. 1256=item Append all messages to a file instead of sending them to STDERR.
929 1257
930This is affected by the global logging level. 1258This is affected by the global logging level.
931 1259
932 $AnyEvent::Log::LOG->log_to_file ($path); (sub { 1260 $AnyEvent::Log::LOG->log_to_file ($path);
1261
1262 PERL_ANYEVENT_LOG=log=file=/some/path
933 1263
934=item Write all messages with priority C<error> and higher to a file. 1264=item Write all messages with priority C<error> and higher to a file.
935 1265
936This writes them only when the global logging level allows it, because 1266This writes them only when the global logging level allows it, because
937it is attached to the default context which is invoked I<after> global 1267it is attached to the default context which is invoked I<after> global
938filtering. 1268filtering.
939 1269
940 $AnyEvent::Log::FILTER->attach 1270 $AnyEvent::Log::FILTER->attach (
941 new AnyEvent::Log::Ctx log_to_file => $path); 1271 new AnyEvent::Log::Ctx log_to_file => $path);
1272
1273 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
942 1274
943This writes them regardless of the global logging level, because it is 1275This writes them regardless of the global logging level, because it is
944attached to the toplevel context, which receives all messages I<before> 1276attached to the toplevel context, which receives all messages I<before>
945the global filtering. 1277the global filtering.
946 1278
947 $AnyEvent::Log::COLLECT->attach ( 1279 $AnyEvent::Log::COLLECT->attach (
948 new AnyEvent::Log::Ctx log_to_file => $path); 1280 new AnyEvent::Log::Ctx log_to_file => $path);
949 1281
1282 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1283
950In both cases, messages are still written to STDERR. 1284In both cases, messages are still written to STDERR.
951 1285
952=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). 1286=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
953 1287
954Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1288Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
955context - this simply circumvents the global filtering for trace messages. 1289context - this simply circumvents the global filtering for trace messages.
956 1290
957 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx; 1291 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
958 $debug->attach ($AnyEvent::Log::LOG); 1292 $debug->attach ($AnyEvent::Log::LOG);
1293
1294 PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
959 1295
960This of course works for any package, not just L<AnyEvent::Debug>, but 1296This of course works for any package, not just L<AnyEvent::Debug>, but
961assumes the log level for AnyEvent::Debug hasn't been changed from the 1297assumes the log level for AnyEvent::Debug hasn't been changed from the
962default. 1298default.
963 1299
967 1303
968 Marc Lehmann <schmorp@schmorp.de> 1304 Marc Lehmann <schmorp@schmorp.de>
969 http://home.schmorp.de/ 1305 http://home.schmorp.de/
970 1306
971=cut 1307=cut
1308

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines