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.22 by root, Sun Aug 21 02:19:30 2011 UTC vs.
Revision 1.45 by root, Sun Oct 2 00:42:04 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
… …
100package AnyEvent::Log; 134package AnyEvent::Log;
101 135
102use Carp (); 136use Carp ();
103use POSIX (); 137use POSIX ();
104 138
139# layout of a context
140# 0 1 2 3 4, 5
141# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
142
105use AnyEvent (); BEGIN { AnyEvent::common_sense } 143use AnyEvent (); BEGIN { AnyEvent::common_sense }
106use AnyEvent::Util (); 144#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
107 145
108our $VERSION = $AnyEvent::VERSION; 146our $VERSION = $AnyEvent::VERSION;
109 147
110our ($COLLECT, $FILTER, $LOG); 148our ($COLLECT, $FILTER, $LOG);
111 149
… …
141=item AnyEvent::Log::log $level, $msg[, @args] 179=item AnyEvent::Log::log $level, $msg[, @args]
142 180
143Requests logging of the given C<$msg> with the given log level, and 181Requests logging of the given C<$msg> with the given log level, and
144returns true if the message was logged I<somewhere>. 182returns true if the message was logged I<somewhere>.
145 183
146For C<fatal> log levels, the program will abort. 184For loglevel C<fatal>, the program will abort.
147 185
148If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the 186If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
149C<$msg> is interpreted as an sprintf format string. 187C<$msg> is interpreted as an sprintf format string.
150 188
151The C<$msg> should not end with C<\n>, but may if that is convenient for 189The C<$msg> should not end with C<\n>, but may if that is convenient for
… …
196 info => 7, 234 info => 7,
197 debug => 8, 235 debug => 8,
198 trace => 9, 236 trace => 9,
199); 237);
200 238
201sub now () { time } 239our $TIME_EXACT;
240
241sub exact_time($) {
242 $TIME_EXACT = shift;
243 *_ts = $AnyEvent::MODEL
244 ? $TIME_EXACT ? \&AE::now : \&AE::time
245 : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
246}
247
248BEGIN {
249 exact_time 0;
250}
202 251
203AnyEvent::post_detect { 252AnyEvent::post_detect {
204 *now = \&AE::now; 253 exact_time $TIME_EXACT;
205}; 254};
206 255
207our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 256our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
208 257
209# time, ctx, level, msg 258# time, ctx, level, msg
… …
219 } 268 }
220 269
221 join "", @res 270 join "", @res
222} 271}
223 272
273sub fatal_exit() {
274 exit 1;
275}
276
224sub _log { 277sub _log {
225 my ($ctx, $level, $format, @args) = @_; 278 my ($ctx, $level, $format, @args) = @_;
226 279
227 $level = $level > 0 && $level <= 9 280 $level = $level > 0 && $level <= 9
228 ? $level+0 281 ? $level+0
229 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 282 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
230 283
231 my $mask = 1 << $level; 284 my $mask = 1 << $level;
232 285
233 my ($success, %seen, @ctx, $now, $fmt); 286 my ($success, %seen, @ctx, $now, @fmt);
234 287
235 do 288 do
236 { 289 {
237 # skip if masked 290 # if !ref, then it's a level number
291 if (!ref $ctx) {
292 $level = $ctx;
238 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
239 if ($ctx->[3]) { 303 if ($ctx->[3]) {
240 # logging target found 304 # logging target found
241 305
242 # now get raw message, unless we have it already 306 # now get raw message, unless we have it already
243 unless ($now) { 307 unless ($now) {
244 $format = $format->() if ref $format; 308 $format = $format->() if ref $format;
245 $format = sprintf $format, @args if @args; 309 $format = sprintf $format, @args if @args;
246 $format =~ s/\n$//; 310 $format =~ s/\n$//;
247 $now = AE::now; 311 $now = _ts;
248 }; 312 };
249 313
250 # format msg 314 # format msg
251 my $str = $ctx->[4] 315 my $str = $ctx->[4]
252 ? $ctx->[4]($now, $_[0], $level, $format) 316 ? $ctx->[4]($now, $_[0], $level, $format)
253 : ($fmt ||= _format $now, $_[0], $level, $format); 317 : ($fmt[$level] ||= _format $now, $_[0], $level, $format);
254 318
255 $success = 1; 319 $success = 1;
256 320
257 $ctx->[3]($str) 321 $ctx->[3]($str)
258 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 322 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
… …
261 } 325 }
262 } 326 }
263 } 327 }
264 while $ctx = pop @ctx; 328 while $ctx = pop @ctx;
265 329
266 exit 1 if $level <= 1; 330 fatal_exit if $level <= 1;
267 331
268 $success 332 $success
269} 333}
270 334
271sub log($$;@) { 335sub log($$;@) {
272 _log 336 _log
273 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 337 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
274 @_; 338 @_;
275} 339}
276 340
277*AnyEvent::log = *AE::log = \&log;
278
279=item $logger = AnyEvent::Log::logger $level[, \$enabled] 341=item $logger = AnyEvent::Log::logger $level[, \$enabled]
280 342
281Creates a code reference that, when called, acts as if the 343Creates a code reference that, when called, acts as if the
282C<AnyEvent::Log::log> function was called at this point with the given 344C<AnyEvent::Log::log> function was called at this point with the given
283level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with 345level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
… …
347 409
348 $LOGGER{$logger+0} = $logger; 410 $LOGGER{$logger+0} = $logger;
349 411
350 _reassess $logger+0; 412 _reassess $logger+0;
351 413
414 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
352 my $guard = AnyEvent::Util::guard { 415 my $guard = AnyEvent::Util::guard (sub {
353 # "clean up" 416 # "clean up"
354 delete $LOGGER{$logger+0}; 417 delete $LOGGER{$logger+0};
355 }; 418 });
356 419
357 sub { 420 sub {
358 $guard if 0; # keep guard alive, but don't cause runtime overhead 421 $guard if 0; # keep guard alive, but don't cause runtime overhead
359 422
360 _log $ctx, $level, @_ 423 _log $ctx, $level, @_
… …
365sub logger($;$) { 428sub logger($;$) {
366 _logger 429 _logger
367 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 430 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
368 @_ 431 @_
369} 432}
433
434=item AnyEvent::Log::exact_time $on
435
436By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
437eventloop time, for the log timestamps. After calling this function with a
438true value it will instead resort to C<AE::time>, i.e. fetch the current
439time on each log message. This only makes a difference for event loops
440that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
441
442This setting can be changed at any time by calling this function.
443
444Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
445initialised, this switch will also decide whether to use C<CORE::time> or
446C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
447available.
370 448
371=back 449=back
372 450
373=head1 LOGGING CONTEXTS 451=head1 LOGGING CONTEXTS
374 452
… …
494This can be used to implement config-file (re-)loading: before loading a 572This can be used to implement config-file (re-)loading: before loading a
495configuration, reset all contexts. 573configuration, reset all contexts.
496 574
497=cut 575=cut
498 576
577our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
578$AnyEvent::VERBOSE = 9;
579
499sub reset { 580sub reset {
500 # hard to kill complex data structures 581 # hard to kill complex data structures
501 # we "recreate" all package loggers and reset the hierarchy 582 # we "recreate" all package loggers and reset the hierarchy
502 while (my ($k, $v) = each %CTX) { 583 while (my ($k, $v) = each %CTX) {
503 @$v = ($k, (1 << 10) - 1 - 1, { }); 584 @$v = ($k, (1 << 10) - 1 - 1, { });
… …
506 } 587 }
507 588
508 @$_ = ($_->[0], (1 << 10) - 1 - 1) 589 @$_ = ($_->[0], (1 << 10) - 1 - 1)
509 for $LOG, $FILTER, $COLLECT; 590 for $LOG, $FILTER, $COLLECT;
510 591
511 $LOG->slaves; 592 #$LOG->slaves;
512 $LOG->title ('$AnyEvent::Log::LOG'); 593 $LOG->title ('$AnyEvent::Log::LOG');
513 $LOG->log_cb (sub { 594 $LOG->log_to_warn;
514 warn shift;
515 0
516 });
517 595
518 $FILTER->slaves ($LOG); 596 $FILTER->slaves ($LOG);
519 $FILTER->title ('$AnyEvent::Log::FILTER'); 597 $FILTER->title ('$AnyEvent::Log::FILTER');
520 $FILTER->level ($AnyEvent::VERBOSE); 598 $FILTER->level ($ORIG_VERBOSE);
521 599
522 $COLLECT->slaves ($FILTER); 600 $COLLECT->slaves ($FILTER);
523 $COLLECT->title ('$AnyEvent::Log::COLLECT'); 601 $COLLECT->title ('$AnyEvent::Log::COLLECT');
524 602
525 _reassess; 603 _reassess;
526} 604}
605
606# override AE::log/logger
607*AnyEvent::log = *AE::log = \&log;
608*AnyEvent::logger = *AE::logger = \&logger;
609
610# convert AnyEvent loggers to AnyEvent::Log loggers
611$_->[0] = ctx $_->[0] # convert "pkg" to "ctx"
612 for values %LOGGER;
527 613
528# create the default logger contexts 614# create the default logger contexts
529$LOG = ctx undef; 615$LOG = ctx undef;
530$FILTER = ctx undef; 616$FILTER = ctx undef;
531$COLLECT = ctx undef; 617$COLLECT = ctx undef;
… …
540package AnyEvent::Log::COLLECT; 626package AnyEvent::Log::COLLECT;
541package AE::Log::COLLECT; 627package AE::Log::COLLECT;
542 628
543package AnyEvent::Log::Ctx; 629package AnyEvent::Log::Ctx;
544 630
545# 0 1 2 3 4
546# [$title, $level, %$slaves, &$logcb, &$fmtcb]
547
548=item $ctx = new AnyEvent::Log::Ctx methodname => param... 631=item $ctx = new AnyEvent::Log::Ctx methodname => param...
549 632
550This is a convenience constructor that makes it simpler to construct 633This is a convenience constructor that makes it simpler to construct
551anonymous logging contexts. 634anonymous logging contexts.
552 635
… …
639 722
640=item $ctx->disable ($level[, $level...]) 723=item $ctx->disable ($level[, $level...])
641 724
642Disables logging for the given levels, leaving all others unchanged. 725Disables logging for the given levels, leaving all others unchanged.
643 726
727=item $ctx->cap ($level)
728
729Caps the maximum priority to the given level, for all messages logged
730to, or passing through, this context. That is, while this doesn't affect
731whether a message is logged or passed on, the maximum priority of messages
732will be limited to the specified level - messages with a higher priority
733will be set to the specified priority.
734
735Another way to view this is that C<< ->level >> filters out messages with
736a too low priority, while C<< ->cap >> modifies messages with a too high
737priority.
738
739This is useful when different log targets have different interpretations
740of priority. For example, for a specific command line program, a wrong
741command line switch might well result in a C<fatal> log message, while the
742same message, logged to syslog, is likely I<not> fatal to the system or
743syslog facility as a whole, but more likely a mere C<error>.
744
745This can be modeled by having a stderr logger that logs messages "as-is"
746and a syslog logger that logs messages with a level cap of, say, C<error>,
747or, for truly system-critical components, actually C<critical>.
748
644=cut 749=cut
645 750
646sub _lvl_lst { 751sub _lvl_lst {
647 map { 752 map {
648 $_ > 0 && $_ <= 9 ? $_+0 753 $_ > 0 && $_ <= 9 ? $_+0
649 : $_ eq "all" ? (1 .. 9) 754 : $_ eq "all" ? (1 .. 9)
650 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 755 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
651 } @_ 756 } @_
652} 757}
653 758
759sub _lvl {
760 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
761}
762
654our $NOP_CB = sub { 0 }; 763our $NOP_CB = sub { 0 };
655 764
656sub levels { 765sub levels {
657 my $ctx = shift; 766 my $ctx = shift;
658 $ctx->[1] = 0; 767 $ctx->[1] = 0;
… …
661 AnyEvent::Log::_reassess; 770 AnyEvent::Log::_reassess;
662} 771}
663 772
664sub level { 773sub level {
665 my $ctx = shift; 774 my $ctx = shift;
666 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
667
668 $ctx->[1] = ((1 << $lvl) - 1) << 1; 775 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
669 AnyEvent::Log::_reassess; 776 AnyEvent::Log::_reassess;
670} 777}
671 778
672sub enable { 779sub enable {
673 my $ctx = shift; 780 my $ctx = shift;
… …
681 $ctx->[1] &= ~(1 << $_) 788 $ctx->[1] &= ~(1 << $_)
682 for &_lvl_lst; 789 for &_lvl_lst;
683 AnyEvent::Log::_reassess; 790 AnyEvent::Log::_reassess;
684} 791}
685 792
793sub cap {
794 my $ctx = shift;
795 $ctx->[5] = &_lvl;
796}
797
686=back 798=back
687 799
688=head3 SLAVE CONTEXTS 800=head3 SLAVE CONTEXTS
689 801
690The following methods attach and detach another logging context to a 802The following methods attach and detach another logging context to a
… …
782logging context, the (numeric) logging level and the raw message string 894logging context, the (numeric) logging level and the raw message string
783and needs to return a formatted log message. In most cases this will be a 895and needs to return a formatted log message. In most cases this will be a
784string, but it could just as well be an array reference that just stores 896string, but it could just as well be an array reference that just stores
785the values. 897the values.
786 898
787If, for some reaosn, you want to use C<caller> to find out more baout the 899If, for some reason, you want to use C<caller> to find out more baout the
788logger then you should walk up the call stack until you are no longer 900logger then you should walk up the call stack until you are no longer
789inside the C<AnyEvent::Log> package. 901inside the C<AnyEvent::Log> package.
790 902
791Example: format just the raw message, with numeric log level in angle 903Example: format just the raw message, with numeric log level in angle
792brackets. 904brackets.
… …
811 "$msg->[3]"; 923 "$msg->[3]";
812 924
813 0 925 0
814 }); 926 });
815 927
928=item $ctx->log_to_warn
929
930Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
931(usually this logs to STDERR).
932
816=item $ctx->log_to_file ($path) 933=item $ctx->log_to_file ($path)
817 934
818Sets the C<log_cb> to log to a file (by appending), unbuffered. 935Sets the C<log_cb> to log to a file (by appending), unbuffered.
819 936
820=item $ctx->log_to_path ($path) 937=item $ctx->log_to_path ($path)
821 938
822Same as C<< ->log_to_file >>, but opens the file for each message. This 939Same as C<< ->log_to_file >>, but opens the file for each message. This
823is much slower, but allows you to change/move/rename/delete the file at 940is much slower, but allows you to change/move/rename/delete the file at
824basically any time. 941basically any time.
825 942
943Needless(?) to say, if you do not want to be bitten by some evil person
944calling C<chdir>, the path should be absolute. Doesn't help with
945C<chroot>, but hey...
946
826=item $ctx->log_to_syslog ([$log_flags]) 947=item $ctx->log_to_syslog ([$facility])
827 948
828Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all 949Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
829the others in the obvious way. If specified, then the C<$log_flags> are 950all the others in the obvious way. If specified, then the C<$facility> is
830simply or'ed onto the priority argument and can contain any C<LOG_xxx> 951used as the facility (C<user>, C<auth>, C<local0> and so on). The default
831flags valid for Sys::Syslog::syslog, except for the priority levels. 952facility is C<user>.
832 953
833Note that this function also sets a C<fmt_cb> - the logging part requires 954Note that this function also sets a C<fmt_cb> - the logging part requires
834an array reference with [$level, $str] as input. 955an array reference with [$level, $str] as input.
835 956
836=cut 957=cut
… …
843 964
844sub fmt_cb { 965sub fmt_cb {
845 my ($ctx, $cb) = @_; 966 my ($ctx, $cb) = @_;
846 967
847 $ctx->[4] = $cb; 968 $ctx->[4] = $cb;
969}
970
971sub log_to_warn {
972 my ($ctx, $path) = @_;
973
974 $ctx->log_cb (sub {
975 warn shift;
976 0
977 });
848} 978}
849 979
850sub log_to_file { 980sub log_to_file {
851 my ($ctx, $path) = @_; 981 my ($ctx, $path) = @_;
852 982
… …
857 syswrite $fh, shift; 987 syswrite $fh, shift;
858 0 988 0
859 }); 989 });
860} 990}
861 991
862sub log_to_file { 992sub log_to_path {
863 my ($ctx, $path) = @_; 993 my ($ctx, $path) = @_;
864 994
865 $ctx->log_cb (sub { 995 $ctx->log_cb (sub {
866 open my $fh, ">>", $path 996 open my $fh, ">>", $path
867 or die "$path: $!"; 997 or die "$path: $!";
… …
870 0 1000 0
871 }); 1001 });
872} 1002}
873 1003
874sub log_to_syslog { 1004sub log_to_syslog {
875 my ($ctx, $flags) = @_; 1005 my ($ctx, $facility) = @_;
876 1006
877 require Sys::Syslog; 1007 require Sys::Syslog;
878 1008
879 $ctx->fmt_cb (sub { 1009 $ctx->fmt_cb (sub {
880 my $str = $_[3]; 1010 my $str = $_[3];
881 $str =~ s/\n(?=.)/\n+ /g; 1011 $str =~ s/\n(?=.)/\n+ /g;
882 1012
883 [$_[2], "($_[1][0]) $str"] 1013 [$_[2], "($_[1][0]) $str"]
884 }); 1014 });
885 1015
1016 $facility ||= "user";
1017
886 $ctx->log_cb (sub { 1018 $ctx->log_cb (sub {
887 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8; 1019 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
888 1020
889 Sys::Syslog::syslog ($flags | ($lvl - 1), $_) 1021 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
890 for split /\n/, $_[0][1]; 1022 for split /\n/, $_[0][1];
891 1023
892 0 1024 0
893 }); 1025 });
894} 1026}
… …
914=cut 1046=cut
915 1047
916*log = \&AnyEvent::Log::_log; 1048*log = \&AnyEvent::Log::_log;
917*logger = \&AnyEvent::Log::_logger; 1049*logger = \&AnyEvent::Log::_logger;
918 1050
1051=back
1052
1053=cut
1054
1055package AnyEvent::Log;
1056
1057=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
1058
1059Logging can also be configured by setting the environment variable
1060C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
1061
1062The value consists of one or more logging context specifications separated
1063by C<:> or whitespace. Each logging specification in turn starts with a
1064context name, followed by C<=>, followed by zero or more comma-separated
1065configuration directives, here are some examples:
1066
1067 # set default logging level
1068 filter=warn
1069
1070 # log to file instead of to stderr
1071 log=file=/tmp/mylog
1072
1073 # log to file in addition to stderr
1074 log=+%file:%file=file=/tmp/mylog
1075
1076 # enable debug log messages, log warnings and above to syslog
1077 filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
1078
1079 # log trace messages (only) from AnyEvent::Debug to file
1080 AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
1081
1082A context name in the log specification can be any of the following:
1083
1084=over 4
1085
1086=item C<collect>, C<filter>, C<log>
1087
1088Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
1089C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
1090
1091=item C<%name>
1092
1093Context names starting with a C<%> are anonymous contexts created when the
1094name is first mentioned. The difference to package contexts is that by
1095default they have no attached slaves.
1096
1097=item a perl package name
1098
1099Any other string references the logging context associated with the given
1100Perl C<package>. In the unlikely case where you want to specify a package
1101context that matches on of the other context name forms, you can add a
1102C<::> to the package name to force interpretation as a package.
1103
1104=back
1105
1106The configuration specifications can be any number of the following:
1107
1108=over 4
1109
1110=item C<stderr>
1111
1112Configures the context to use Perl's C<warn> function (which typically
1113logs to C<STDERR>). Works like C<log_to_warn>.
1114
1115=item C<file=>I<path>
1116
1117Configures the context to log to a file with the given path. Works like
1118C<log_to_file>.
1119
1120=item C<path=>I<path>
1121
1122Configures the context to log to a file with the given path. Works like
1123C<log_to_path>.
1124
1125=item C<syslog> or C<syslog=>I<expr>
1126
1127Configures the context to log to syslog. If I<expr> is given, then it is
1128evaluated in the L<Sys::Syslog> package, so you could use:
1129
1130 log=syslog=LOG_LOCAL0
1131
1132=item C<nolog>
1133
1134Configures the context to not log anything by itself, which is the
1135default. Same as C<< $ctx->log_cb (undef) >>.
1136
1137=item C<cap=>I<level>
1138
1139Caps logging messages entering this context at the given level, i.e.
1140reduces the priority of messages with higher priority than this level. The
1141default is C<0> (or C<off>), meaning the priority will not be touched.
1142
1143=item C<0> or C<off>
1144
1145Sets the logging level of the context to C<0>, i.e. all messages will be
1146filtered out.
1147
1148=item C<all>
1149
1150Enables all logging levels, i.e. filtering will effectively be switched
1151off (the default).
1152
1153=item C<only>
1154
1155Disables all logging levels, and changes the interpretation of following
1156level specifications to enable the specified level only.
1157
1158Example: only enable debug messages for a context.
1159
1160 context=only,debug
1161
1162=item C<except>
1163
1164Enables all logging levels, and changes the interpretation of following
1165level specifications to disable that level. Rarely used.
1166
1167Example: enable all logging levels except fatal and trace (this is rather
1168nonsensical).
1169
1170 filter=exept,fatal,trace
1171
1172=item C<level>
1173
1174Enables all logging levels, and changes the interpretation of following
1175level specifications to be "that level or any higher priority
1176message". This is the default.
1177
1178Example: log anything at or above warn level.
1179
1180 filter=warn
1181
1182 # or, more verbose
1183 filter=only,level,warn
1184
1185=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
1186
1187A numeric loglevel or the name of a loglevel will be interpreted according
1188to the most recent C<only>, C<except> or C<level> directive. By default,
1189specifying a logging level enables that and any higher priority messages.
1190
1191=item C<+>I<context>
1192
1193Attaches the named context as slave to the context.
1194
1195=item C<+>
1196
1197A line C<+> detaches all contexts, i.e. clears the slave list from the
1198context. Anonymous (C<%name>) contexts have no attached slaves by default,
1199but package contexts have the parent context as slave by default.
1200
1201Example: log messages from My::Module to a file, do not send them to the
1202default log collector.
1203
1204 My::Module=+,file=/tmp/mymodulelog
1205
1206=back
1207
1208Any character can be escaped by prefixing it with a C<\> (backslash), as
1209usual, so to log to a file containing a comma, colon, backslash and some
1210spaces in the filename, you would do this:
1211
1212 PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
1213
1214Since whitespace (which includes newlines) is allowed, it is fine to
1215specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
1216
1217 PERL_ANYEVENT_LOG="
1218 filter=warn
1219 AnyEvent::Debug=+%trace
1220 %trace=only,trace,+log
1221 " myprog
1222
1223Also, in the unlikely case when you want to concatenate specifications,
1224use whitespace as separator, as C<::> will be interpreted as part of a
1225module name, an empty spec with two separators:
1226
1227 PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
1228
1229=cut
1230
1231for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1232 my %anon;
1233
1234 my $pkg = sub {
1235 $_[0] eq "log" ? $LOG
1236 : $_[0] eq "filter" ? $FILTER
1237 : $_[0] eq "collect" ? $COLLECT
1238 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1239 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1240 : die # never reached?
1241 };
1242
1243 /\G[[:space:]]+/gc; # skip initial whitespace
1244
1245 while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
1246 my $ctx = $pkg->($1);
1247 my $level = "level";
1248
1249 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1250 for ("$1") {
1251 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1252 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1253 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1254 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1255 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1256 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1257 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1258 } elsif ($_ eq "+" ) { $ctx->slaves;
1259 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1260 } elsif ($_ eq "all" ) { $ctx->level ("all");
1261 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1262 } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
1263 } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
1264 } elsif (/^\d$/ ) { $ctx->$level ($_);
1265 } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
1266 } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
1267 }
1268 }
1269
1270 /\G,/gc or last;
1271 }
1272
1273 /\G[:[:space:]]+/gc or last;
1274 }
1275
1276 /\G[[:space:]]+/gc; # skip trailing whitespace
1277
1278 if (/\G(.+)/g) {
1279 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1280 }
1281}
1282
9191; 12831;
920 1284
921=back
922
923=head1 EXAMPLES 1285=head1 EXAMPLES
924 1286
925This section shows some common configurations. 1287This section shows some common configurations, both as code, and as
1288C<PERL_ANYEVENT_LOG> string.
926 1289
927=over 4 1290=over 4
928 1291
929=item Setting the global logging level. 1292=item Setting the global logging level.
930 1293
931Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before 1294Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
932running your program, or modify the log level of the root context: 1295running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
1296the root context at runtime:
933 1297
934 PERL_ANYEVENT_VERBOSE=5 ./myprog 1298 PERL_ANYEVENT_VERBOSE=5 ./myprog
935 1299
1300 PERL_ANYEVENT_LOG=log=warn
1301
936 $AnyEvent::Log::FILTER->level ("warn"); 1302 $AnyEvent::Log::FILTER->level ("warn");
937 1303
938=item Append all messages to a file instead of sending them to STDERR. 1304=item Append all messages to a file instead of sending them to STDERR.
939 1305
940This is affected by the global logging level. 1306This is affected by the global logging level.
941 1307
942 $AnyEvent::Log::LOG->log_to_file ($path); (sub { 1308 $AnyEvent::Log::LOG->log_to_file ($path);
1309
1310 PERL_ANYEVENT_LOG=log=file=/some/path
943 1311
944=item Write all messages with priority C<error> and higher to a file. 1312=item Write all messages with priority C<error> and higher to a file.
945 1313
946This writes them only when the global logging level allows it, because 1314This writes them only when the global logging level allows it, because
947it is attached to the default context which is invoked I<after> global 1315it is attached to the default context which is invoked I<after> global
948filtering. 1316filtering.
949 1317
950 $AnyEvent::Log::FILTER->attach 1318 $AnyEvent::Log::FILTER->attach (
951 new AnyEvent::Log::Ctx log_to_file => $path); 1319 new AnyEvent::Log::Ctx log_to_file => $path);
1320
1321 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
952 1322
953This writes them regardless of the global logging level, because it is 1323This writes them regardless of the global logging level, because it is
954attached to the toplevel context, which receives all messages I<before> 1324attached to the toplevel context, which receives all messages I<before>
955the global filtering. 1325the global filtering.
956 1326
957 $AnyEvent::Log::COLLECT->attach ( 1327 $AnyEvent::Log::COLLECT->attach (
958 new AnyEvent::Log::Ctx log_to_file => $path); 1328 new AnyEvent::Log::Ctx log_to_file => $path);
959 1329
1330 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1331
960In both cases, messages are still written to STDERR. 1332In both cases, messages are still written to STDERR.
1333
1334=item Additionally log all messages with C<warn> and higher priority to
1335C<syslog>, but cap at C<error>.
1336
1337This logs all messages to the default log target, but also logs messages
1338with priority C<warn> or higher (and not filtered otherwise) to syslog
1339facility C<user>. Messages with priority higher than C<error> will be
1340logged 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
961 1350
962=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).
963 1352
964Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1353Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
965context - this simply circumvents the global filtering for trace messages. 1354context - this simply circumvents the global filtering for trace messages.
966 1355
967 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx; 1356 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
968 $debug->attach ($AnyEvent::Log::LOG); 1357 $debug->attach ($AnyEvent::Log::LOG);
1358
1359 PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
969 1360
970This of course works for any package, not just L<AnyEvent::Debug>, but 1361This of course works for any package, not just L<AnyEvent::Debug>, but
971assumes the log level for AnyEvent::Debug hasn't been changed from the 1362assumes the log level for AnyEvent::Debug hasn't been changed from the
972default. 1363default.
973 1364
… …
977 1368
978 Marc Lehmann <schmorp@schmorp.de> 1369 Marc Lehmann <schmorp@schmorp.de>
979 http://home.schmorp.de/ 1370 http://home.schmorp.de/
980 1371
981=cut 1372=cut
1373

Diff Legend

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