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.24 by root, Sun Aug 21 03:24:59 2011 UTC vs.
Revision 1.52 by root, Thu Mar 22 19:27:30 2012 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
9 use AnyEvent; 9 use AnyEvent;
10 10
11 AE::log debug => "hit my knee"; 11 AE::log fatal => "no config found, cannot continue"; # never returns
12 AE::log warn => "it's a bit too hot"; 12 AE::log alert => "the battery died";
13 AE::log error => "the flag was false!"; 13 AE::log crit => "the battery temperature is too hot";
14 AE::log fatal => "the bit toggled! run!"; # never returns 14 AE::log error => "division by zero attempted";
15 AE::log warn => "couldn't delete the file";
16 AE::log note => "wanted to create config, but config already exists";
17 AE::log info => "file soandso successfully deleted";
18 AE::log debug => "the function returned 3";
19 AE::log trace => "going to call function abc";
15 20
16 # "complex" use (for speed sensitive code): 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):
17 35
18 use AnyEvent::Log; 36 use AnyEvent::Log;
19 37
20 my $tracer = AnyEvent::Log::logger trace => \$my $trace; 38 my $tracer = AnyEvent::Log::logger trace => \$my $trace;
21 39
22 $tracer->("i am here") if $trace; 40 $tracer->("i am here") if $trace;
23 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; 41 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
24 42
25 # configuration: 43Configuration (also look at the EXAMPLES section):
26 44
27 # set logging for the current package to errors and higher only 45 # set logging for the current package to errors and higher only
28 AnyEvent::Log::ctx->level ("error"); 46 AnyEvent::Log::ctx->level ("error");
29 47
30 # set logging level to suppress anything below "notice" 48 # set logging level to suppress anything below "notice"
… …
32 50
33 # send all critical and higher priority messages to syslog, 51 # send all critical and higher priority messages to syslog,
34 # regardless of (most) other settings 52 # regardless of (most) other settings
35 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx 53 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
36 level => "critical", 54 level => "critical",
37 log_to_syslog => 0, 55 log_to_syslog => "user",
38 ); 56 );
39
40 # see also EXAMPLES, below
41 57
42=head1 DESCRIPTION 58=head1 DESCRIPTION
43 59
44This module implements a relatively simple "logging framework". It doesn't 60This module implements a relatively simple "logging framework". It doesn't
45attempt to be "the" logging solution or even "a" logging solution for 61attempt to be "the" logging solution or even "a" logging solution for
46AnyEvent - AnyEvent simply creates logging messages internally, and this 62AnyEvent - AnyEvent simply creates logging messages internally, and this
47module more or less exposes the mechanism, with some extra spiff to allow 63module more or less exposes the mechanism, with some extra spiff to allow
48using it from other modules as well. 64using it from other modules as well.
49 65
50Remember that the default verbosity level is C<0> (C<off>), so nothing 66Remember that the default verbosity level is C<4> (C<error>), so only
51will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number 67errors and more important messages will be logged, unless you set
52before starting your program, or change the logging level at runtime with 68C<PERL_ANYEVENT_VERBOSE> to a higher number before starting your program
53something like: 69(C<AE_VERBOSE=5> is recommended during development), or change the logging
70level at runtime with something like:
54 71
55 use AnyEvent::Log; 72 use AnyEvent::Log;
56 AnyEvent::Log::FILTER->level ("info"); 73 $AnyEvent::Log::FILTER->level ("info");
57 74
58The design goal behind this module was to keep it simple (and small), 75The design goal behind this module was to keep it simple (and small),
59but make it powerful enough to be potentially useful for any module, and 76but make it powerful enough to be potentially useful for any module, and
60extensive enough for the most common tasks, such as logging to multiple 77extensive enough for the most common tasks, such as logging to multiple
61targets, or being able to log into a database. 78targets, or being able to log into a database.
62 79
80The module is also usable before AnyEvent itself is initialised, in which
81case some of the functionality might be reduced.
82
63The amount of documentation might indicate otherwise, but the module is 83The amount of documentation might indicate otherwise, but the runtime part
64still just below 300 lines of code. 84of the module is still just below 300 lines of code.
65 85
66=head1 LOGGING LEVELS 86=head1 LOGGING LEVELS
67 87
68Logging levels in this module range from C<1> (highest priority) to C<9> 88Logging levels in this module range from C<1> (highest priority) to C<9>
69(lowest priority). Note that the lowest numerical value is the highest 89(lowest priority). Note that the lowest numerical value is the highest
… …
71numerical value". 91numerical value".
72 92
73Instead of specifying levels by name you can also specify them by aliases: 93Instead of specifying levels by name you can also specify them by aliases:
74 94
75 LVL NAME SYSLOG PERL NOTE 95 LVL NAME SYSLOG PERL NOTE
76 1 fatal emerg exit aborts program! 96 1 fatal emerg exit system unusable, aborts program!
77 2 alert 97 2 alert failure in primary system
78 3 critical crit 98 3 critical crit failure in backup system
79 4 error err die 99 4 error err die non-urgent program errors, a bug
80 5 warn warning 100 5 warn warning possible problem, not necessarily error
81 6 note notice 101 6 note notice unusual conditions
82 7 info 102 7 info normal messages, no action required
83 8 debug 103 8 debug debugging messages for development
84 9 trace 104 9 trace copious tracing output
85 105
86As you can see, some logging levels have multiple aliases - the first one 106As you can see, some logging levels have multiple aliases - the first one
87is the "official" name, the second one the "syslog" name (if it differs) 107is the "official" name, the second one the "syslog" name (if it differs)
88and the third one the "perl" name, suggesting that you log C<die> messages 108and the third one the "perl" name, suggesting (only!) that you log C<die>
89at C<error> priority. 109messages at C<error> priority. The NOTE column tries to provide some
110rationale on how to chose a logging level.
90 111
112As a rough guideline, levels 1..3 are primarily meant for users of the
113program (admins, staff), and are the only ones logged to STDERR by
114default. Levels 4..6 are meant for users and developers alike, while
115levels 7..9 are usually meant for developers.
116
91You can normally only log a single message at highest priority level 117You can normally only log a message once at highest priority level (C<1>,
92(C<1>, C<fatal>), because logging a fatal message will also quit the 118C<fatal>), because logging a fatal message will also quit the program - so
93program - so use it sparingly :) 119use it sparingly :)
120
121For example, a program that finds an unknown switch on the commandline
122might well use a fatal logging level to tell users about it - the "system"
123in this case would be the program, or module.
94 124
95Some methods also offer some extra levels, such as C<0>, C<off>, C<none> 125Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
96or C<all> - these are only valid in the methods they are documented for. 126or C<all> - these are only valid for the methods that documented them.
97 127
98=head1 LOGGING FUNCTIONS 128=head1 LOGGING FUNCTIONS
99 129
100These functions allow you to log messages. They always use the caller's 130The following functions allow you to log messages. They always use the
101package as a "logging context". Also, the main logging function C<log> is 131caller's package as a "logging context". Also, the main logging function,
102callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is 132C<log>, is aliased to C<AnyEvent::log> and C<AE::log> when the C<AnyEvent>
103loaded. 133module is loaded.
104 134
105=over 4 135=over 4
106 136
107=cut 137=cut
108 138
109package AnyEvent::Log; 139package AnyEvent::Log;
110 140
111use Carp (); 141use Carp ();
112use POSIX (); 142use POSIX ();
113 143
144# layout of a context
145# 0 1 2 3 4, 5
146# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
147
114use AnyEvent (); BEGIN { AnyEvent::common_sense } 148use AnyEvent (); BEGIN { AnyEvent::common_sense }
115use AnyEvent::Util (); 149#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
116 150
117our $VERSION = $AnyEvent::VERSION; 151our $VERSION = $AnyEvent::VERSION;
118 152
119our ($COLLECT, $FILTER, $LOG); 153our ($COLLECT, $FILTER, $LOG);
120 154
… …
150=item AnyEvent::Log::log $level, $msg[, @args] 184=item AnyEvent::Log::log $level, $msg[, @args]
151 185
152Requests logging of the given C<$msg> with the given log level, and 186Requests logging of the given C<$msg> with the given log level, and
153returns true if the message was logged I<somewhere>. 187returns true if the message was logged I<somewhere>.
154 188
155For C<fatal> log levels, the program will abort. 189For loglevel C<fatal>, the program will abort.
156 190
157If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the 191If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
158C<$msg> is interpreted as an sprintf format string. 192C<$msg> is interpreted as an sprintf format string.
159 193
160The C<$msg> should not end with C<\n>, but may if that is convenient for 194The C<$msg> should not end with C<\n>, but may if that is convenient for
… …
162 196
163Last not least, C<$msg> might be a code reference, in which case it is 197Last not least, C<$msg> might be a code reference, in which case it is
164supposed to return the message. It will be called only then the message 198supposed to return the message. It will be called only then the message
165actually gets logged, which is useful if it is costly to create the 199actually gets logged, which is useful if it is costly to create the
166message in the first place. 200message in the first place.
201
202This function takes care of saving and restoring C<$!> and C<$@>, so you
203don't have to.
167 204
168Whether the given message will be logged depends on the maximum log level 205Whether the given message will be logged depends on the maximum log level
169and the caller's package. The return value can be used to ensure that 206and the caller's package. The return value can be used to ensure that
170messages or not "lost" - for example, when L<AnyEvent::Debug> detects a 207messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
171runtime error it tries to log it at C<die> level, but if that message is 208runtime error it tries to log it at C<die> level, but if that message is
… …
205 info => 7, 242 info => 7,
206 debug => 8, 243 debug => 8,
207 trace => 9, 244 trace => 9,
208); 245);
209 246
210sub now () { time } 247our $TIME_EXACT;
248
249sub exact_time($) {
250 $TIME_EXACT = shift;
251 *_ts = $AnyEvent::MODEL
252 ? $TIME_EXACT ? \&AE::now : \&AE::time
253 : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
254}
255
256BEGIN {
257 exact_time 0;
258}
211 259
212AnyEvent::post_detect { 260AnyEvent::post_detect {
213 *now = \&AE::now; 261 exact_time $TIME_EXACT;
214}; 262};
215 263
216our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 264our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
217 265
218# time, ctx, level, msg 266# time, ctx, level, msg
… …
228 } 276 }
229 277
230 join "", @res 278 join "", @res
231} 279}
232 280
281sub fatal_exit() {
282 exit 1;
283}
284
233sub _log { 285sub _log {
234 my ($ctx, $level, $format, @args) = @_; 286 my ($ctx, $level, $format, @args) = @_;
235 287
236 $level = $level > 0 && $level <= 9 288 $level = $level > 0 && $level <= 9
237 ? $level+0 289 ? $level+0
238 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 290 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
239 291
240 my $mask = 1 << $level; 292 my $mask = 1 << $level;
241 293
242 my ($success, %seen, @ctx, $now, $fmt); 294 my ($success, %seen, @ctx, $now, @fmt);
243 295
244 do 296 do
245 { 297 {
246 # skip if masked 298 # if !ref, then it's a level number
299 if (!ref $ctx) {
300 $level = $ctx;
247 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) { 301 } elsif ($ctx->[1] & $mask and !$seen{$ctx+0}++) {
302 # logging/recursing into this context
303
304 # level cap
305 if ($ctx->[5] > $level) {
306 push @ctx, $level; # restore level when going up in tree
307 $level = $ctx->[5];
308 }
309
310 # log if log cb
248 if ($ctx->[3]) { 311 if ($ctx->[3]) {
249 # logging target found 312 # logging target found
313
314 local ($!, $@);
250 315
251 # now get raw message, unless we have it already 316 # now get raw message, unless we have it already
252 unless ($now) { 317 unless ($now) {
253 $format = $format->() if ref $format; 318 $format = $format->() if ref $format;
254 $format = sprintf $format, @args if @args; 319 $format = sprintf $format, @args if @args;
255 $format =~ s/\n$//; 320 $format =~ s/\n$//;
256 $now = AE::now; 321 $now = _ts;
257 }; 322 };
258 323
259 # format msg 324 # format msg
260 my $str = $ctx->[4] 325 my $str = $ctx->[4]
261 ? $ctx->[4]($now, $_[0], $level, $format) 326 ? $ctx->[4]($now, $_[0], $level, $format)
262 : ($fmt ||= _format $now, $_[0], $level, $format); 327 : ($fmt[$level] ||= _format $now, $_[0], $level, $format);
263 328
264 $success = 1; 329 $success = 1;
265 330
266 $ctx->[3]($str) 331 $ctx->[3]($str)
267 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 332 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
… …
270 } 335 }
271 } 336 }
272 } 337 }
273 while $ctx = pop @ctx; 338 while $ctx = pop @ctx;
274 339
275 exit 1 if $level <= 1; 340 fatal_exit if $level <= 1;
276 341
277 $success 342 $success
278} 343}
279 344
280sub log($$;@) { 345sub log($$;@) {
281 _log 346 _log
282 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 347 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
283 @_; 348 @_;
284} 349}
285 350
286*AnyEvent::log = *AE::log = \&log;
287
288=item $logger = AnyEvent::Log::logger $level[, \$enabled] 351=item $logger = AnyEvent::Log::logger $level[, \$enabled]
289 352
290Creates a code reference that, when called, acts as if the 353Creates a code reference that, when called, acts as if the
291C<AnyEvent::Log::log> function was called at this point with the given 354C<AnyEvent::Log::log> function was called at this point with the given
292level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with 355level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
… …
356 419
357 $LOGGER{$logger+0} = $logger; 420 $LOGGER{$logger+0} = $logger;
358 421
359 _reassess $logger+0; 422 _reassess $logger+0;
360 423
424 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
361 my $guard = AnyEvent::Util::guard { 425 my $guard = AnyEvent::Util::guard (sub {
362 # "clean up" 426 # "clean up"
363 delete $LOGGER{$logger+0}; 427 delete $LOGGER{$logger+0};
364 }; 428 });
365 429
366 sub { 430 sub {
367 $guard if 0; # keep guard alive, but don't cause runtime overhead 431 $guard if 0; # keep guard alive, but don't cause runtime overhead
368 432
369 _log $ctx, $level, @_ 433 _log $ctx, $level, @_
… …
374sub logger($;$) { 438sub logger($;$) {
375 _logger 439 _logger
376 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 440 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
377 @_ 441 @_
378} 442}
443
444=item AnyEvent::Log::exact_time $on
445
446By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
447eventloop time, for the log timestamps. After calling this function with a
448true value it will instead resort to C<AE::time>, i.e. fetch the current
449time on each log message. This only makes a difference for event loops
450that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
451
452This setting can be changed at any time by calling this function.
453
454Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
455initialised, this switch will also decide whether to use C<CORE::time> or
456C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
457available.
379 458
380=back 459=back
381 460
382=head1 LOGGING CONTEXTS 461=head1 LOGGING CONTEXTS
383 462
… …
503This can be used to implement config-file (re-)loading: before loading a 582This can be used to implement config-file (re-)loading: before loading a
504configuration, reset all contexts. 583configuration, reset all contexts.
505 584
506=cut 585=cut
507 586
587our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
588$AnyEvent::VERBOSE = 9;
589
508sub reset { 590sub reset {
509 # hard to kill complex data structures 591 # hard to kill complex data structures
510 # we "recreate" all package loggers and reset the hierarchy 592 # we "recreate" all package loggers and reset the hierarchy
511 while (my ($k, $v) = each %CTX) { 593 while (my ($k, $v) = each %CTX) {
512 @$v = ($k, (1 << 10) - 1 - 1, { }); 594 @$v = ($k, (1 << 10) - 1 - 1, { });
… …
515 } 597 }
516 598
517 @$_ = ($_->[0], (1 << 10) - 1 - 1) 599 @$_ = ($_->[0], (1 << 10) - 1 - 1)
518 for $LOG, $FILTER, $COLLECT; 600 for $LOG, $FILTER, $COLLECT;
519 601
520 $LOG->slaves; 602 #$LOG->slaves;
521 $LOG->title ('$AnyEvent::Log::LOG'); 603 $LOG->title ('$AnyEvent::Log::LOG');
522 $LOG->log_cb (sub { 604 $LOG->log_to_warn;
523 warn shift;
524 0
525 });
526 605
527 $FILTER->slaves ($LOG); 606 $FILTER->slaves ($LOG);
528 $FILTER->title ('$AnyEvent::Log::FILTER'); 607 $FILTER->title ('$AnyEvent::Log::FILTER');
529 $FILTER->level ($AnyEvent::VERBOSE); 608 $FILTER->level ($ORIG_VERBOSE);
530 609
531 $COLLECT->slaves ($FILTER); 610 $COLLECT->slaves ($FILTER);
532 $COLLECT->title ('$AnyEvent::Log::COLLECT'); 611 $COLLECT->title ('$AnyEvent::Log::COLLECT');
533 612
534 _reassess; 613 _reassess;
535} 614}
615
616# override AE::log/logger
617*AnyEvent::log = *AE::log = \&log;
618*AnyEvent::logger = *AE::logger = \&logger;
619
620# convert AnyEvent loggers to AnyEvent::Log loggers
621$_->[0] = ctx $_->[0] # convert "pkg" to "ctx"
622 for values %LOGGER;
536 623
537# create the default logger contexts 624# create the default logger contexts
538$LOG = ctx undef; 625$LOG = ctx undef;
539$FILTER = ctx undef; 626$FILTER = ctx undef;
540$COLLECT = ctx undef; 627$COLLECT = ctx undef;
… …
549package AnyEvent::Log::COLLECT; 636package AnyEvent::Log::COLLECT;
550package AE::Log::COLLECT; 637package AE::Log::COLLECT;
551 638
552package AnyEvent::Log::Ctx; 639package AnyEvent::Log::Ctx;
553 640
554# 0 1 2 3 4
555# [$title, $level, %$slaves, &$logcb, &$fmtcb]
556
557=item $ctx = new AnyEvent::Log::Ctx methodname => param... 641=item $ctx = new AnyEvent::Log::Ctx methodname => param...
558 642
559This is a convenience constructor that makes it simpler to construct 643This is a convenience constructor that makes it simpler to construct
560anonymous logging contexts. 644anonymous logging contexts.
561 645
… …
648 732
649=item $ctx->disable ($level[, $level...]) 733=item $ctx->disable ($level[, $level...])
650 734
651Disables logging for the given levels, leaving all others unchanged. 735Disables logging for the given levels, leaving all others unchanged.
652 736
737=item $ctx->cap ($level)
738
739Caps the maximum priority to the given level, for all messages logged
740to, or passing through, this context. That is, while this doesn't affect
741whether a message is logged or passed on, the maximum priority of messages
742will be limited to the specified level - messages with a higher priority
743will be set to the specified priority.
744
745Another way to view this is that C<< ->level >> filters out messages with
746a too low priority, while C<< ->cap >> modifies messages with a too high
747priority.
748
749This is useful when different log targets have different interpretations
750of priority. For example, for a specific command line program, a wrong
751command line switch might well result in a C<fatal> log message, while the
752same message, logged to syslog, is likely I<not> fatal to the system or
753syslog facility as a whole, but more likely a mere C<error>.
754
755This can be modeled by having a stderr logger that logs messages "as-is"
756and a syslog logger that logs messages with a level cap of, say, C<error>,
757or, for truly system-critical components, actually C<critical>.
758
653=cut 759=cut
654 760
655sub _lvl_lst { 761sub _lvl_lst {
656 map { 762 map {
657 $_ > 0 && $_ <= 9 ? $_+0 763 $_ > 0 && $_ <= 9 ? $_+0
658 : $_ eq "all" ? (1 .. 9) 764 : $_ eq "all" ? (1 .. 9)
659 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 765 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
660 } @_ 766 } @_
661} 767}
662 768
769sub _lvl {
770 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
771}
772
663our $NOP_CB = sub { 0 }; 773our $NOP_CB = sub { 0 };
664 774
665sub levels { 775sub levels {
666 my $ctx = shift; 776 my $ctx = shift;
667 $ctx->[1] = 0; 777 $ctx->[1] = 0;
… …
670 AnyEvent::Log::_reassess; 780 AnyEvent::Log::_reassess;
671} 781}
672 782
673sub level { 783sub level {
674 my $ctx = shift; 784 my $ctx = shift;
675 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
676
677 $ctx->[1] = ((1 << $lvl) - 1) << 1; 785 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
678 AnyEvent::Log::_reassess; 786 AnyEvent::Log::_reassess;
679} 787}
680 788
681sub enable { 789sub enable {
682 my $ctx = shift; 790 my $ctx = shift;
… …
690 $ctx->[1] &= ~(1 << $_) 798 $ctx->[1] &= ~(1 << $_)
691 for &_lvl_lst; 799 for &_lvl_lst;
692 AnyEvent::Log::_reassess; 800 AnyEvent::Log::_reassess;
693} 801}
694 802
803sub cap {
804 my $ctx = shift;
805 $ctx->[5] = &_lvl;
806}
807
695=back 808=back
696 809
697=head3 SLAVE CONTEXTS 810=head3 SLAVE CONTEXTS
698 811
699The following methods attach and detach another logging context to a 812The following methods attach and detach another logging context to a
… …
786 899
787Replaces the formatting callback on the context (C<undef> restores the 900Replaces the formatting callback on the context (C<undef> restores the
788default formatter). 901default formatter).
789 902
790The callback is passed the (possibly fractional) timestamp, the original 903The callback is passed the (possibly fractional) timestamp, the original
791logging context, the (numeric) logging level and the raw message string 904logging context (object, not title), the (numeric) logging level and
792and needs to return a formatted log message. In most cases this will be a 905the raw message string and needs to return a formatted log message. In
793string, but it could just as well be an array reference that just stores 906most cases this will be a string, but it could just as well be an array
794the values. 907reference that just stores the values.
795 908
796If, for some reaosn, you want to use C<caller> to find out more baout the 909If, for some reason, you want to use C<caller> to find out more about the
797logger then you should walk up the call stack until you are no longer 910logger then you should walk up the call stack until you are no longer
798inside the C<AnyEvent::Log> package. 911inside the C<AnyEvent::Log> package.
799 912
800Example: format just the raw message, with numeric log level in angle 913Example: format just the raw message, with numeric log level in angle
801brackets. 914brackets.
… …
805 918
806 "<$lvl>$msg\n" 919 "<$lvl>$msg\n"
807 }); 920 });
808 921
809Example: return an array reference with just the log values, and use 922Example: return an array reference with just the log values, and use
810C<PApp::SQL::sql_exec> to store the emssage in a database. 923C<PApp::SQL::sql_exec> to store the message in a database.
811 924
812 $ctx->fmt_cb (sub { \@_ }); 925 $ctx->fmt_cb (sub { \@_ });
813 $ctx->log_cb (sub { 926 $ctx->log_cb (sub {
814 my ($msg) = @_; 927 my ($msg) = @_;
815 928
… …
820 "$msg->[3]"; 933 "$msg->[3]";
821 934
822 0 935 0
823 }); 936 });
824 937
938=item $ctx->log_to_warn
939
940Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
941(usually this logs to STDERR).
942
825=item $ctx->log_to_file ($path) 943=item $ctx->log_to_file ($path)
826 944
827Sets the C<log_cb> to log to a file (by appending), unbuffered. 945Sets the C<log_cb> to log to a file (by appending), unbuffered.
828 946
829=item $ctx->log_to_path ($path) 947=item $ctx->log_to_path ($path)
830 948
831Same as C<< ->log_to_file >>, but opens the file for each message. This 949Same 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 950is much slower, but allows you to change/move/rename/delete the file at
833basically any time. 951basically any time.
834 952
953Needless(?) to say, if you do not want to be bitten by some evil person
954calling C<chdir>, the path should be absolute. Doesn't help with
955C<chroot>, but hey...
956
835=item $ctx->log_to_syslog ([$log_flags]) 957=item $ctx->log_to_syslog ([$facility])
836 958
837Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all 959Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
838the others in the obvious way. If specified, then the C<$log_flags> are 960all the others in the obvious way. If specified, then the C<$facility> is
839simply or'ed onto the priority argument and can contain any C<LOG_xxx> 961used as the facility (C<user>, C<auth>, C<local0> and so on). The default
840flags valid for Sys::Syslog::syslog, except for the priority levels. 962facility is C<user>.
841 963
842Note that this function also sets a C<fmt_cb> - the logging part requires 964Note that this function also sets a C<fmt_cb> - the logging part requires
843an array reference with [$level, $str] as input. 965an array reference with [$level, $str] as input.
844 966
845=cut 967=cut
… …
852 974
853sub fmt_cb { 975sub fmt_cb {
854 my ($ctx, $cb) = @_; 976 my ($ctx, $cb) = @_;
855 977
856 $ctx->[4] = $cb; 978 $ctx->[4] = $cb;
979}
980
981sub log_to_warn {
982 my ($ctx, $path) = @_;
983
984 $ctx->log_cb (sub {
985 warn shift;
986 0
987 });
857} 988}
858 989
859sub log_to_file { 990sub log_to_file {
860 my ($ctx, $path) = @_; 991 my ($ctx, $path) = @_;
861 992
… …
866 syswrite $fh, shift; 997 syswrite $fh, shift;
867 0 998 0
868 }); 999 });
869} 1000}
870 1001
871sub log_to_file { 1002sub log_to_path {
872 my ($ctx, $path) = @_; 1003 my ($ctx, $path) = @_;
873 1004
874 $ctx->log_cb (sub { 1005 $ctx->log_cb (sub {
875 open my $fh, ">>", $path 1006 open my $fh, ">>", $path
876 or die "$path: $!"; 1007 or die "$path: $!";
… …
879 0 1010 0
880 }); 1011 });
881} 1012}
882 1013
883sub log_to_syslog { 1014sub log_to_syslog {
884 my ($ctx, $flags) = @_; 1015 my ($ctx, $facility) = @_;
885 1016
886 require Sys::Syslog; 1017 require Sys::Syslog;
887 1018
888 $ctx->fmt_cb (sub { 1019 $ctx->fmt_cb (sub {
889 my $str = $_[3]; 1020 my $str = $_[3];
890 $str =~ s/\n(?=.)/\n+ /g; 1021 $str =~ s/\n(?=.)/\n+ /g;
891 1022
892 [$_[2], "($_[1][0]) $str"] 1023 [$_[2], "($_[1][0]) $str"]
893 }); 1024 });
894 1025
1026 $facility ||= "user";
1027
895 $ctx->log_cb (sub { 1028 $ctx->log_cb (sub {
896 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8; 1029 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
897 1030
898 Sys::Syslog::syslog ($flags | ($lvl - 1), $_) 1031 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
899 for split /\n/, $_[0][1]; 1032 for split /\n/, $_[0][1];
900 1033
901 0 1034 0
902 }); 1035 });
903} 1036}
… …
913 1046
914=item $ctx->log ($level, $msg[, @params]) 1047=item $ctx->log ($level, $msg[, @params])
915 1048
916Same as C<AnyEvent::Log::log>, but uses the given context as log context. 1049Same as C<AnyEvent::Log::log>, but uses the given context as log context.
917 1050
1051Example: log a message in the context of another package.
1052
1053 (AnyEvent::Log::ctx "Other::Package")->log (warn => "heely bo");
1054
918=item $logger = $ctx->logger ($level[, \$enabled]) 1055=item $logger = $ctx->logger ($level[, \$enabled])
919 1056
920Same as C<AnyEvent::Log::logger>, but uses the given context as log 1057Same as C<AnyEvent::Log::logger>, but uses the given context as log
921context. 1058context.
922 1059
923=cut 1060=cut
924 1061
925*log = \&AnyEvent::Log::_log; 1062*log = \&AnyEvent::Log::_log;
926*logger = \&AnyEvent::Log::_logger; 1063*logger = \&AnyEvent::Log::_logger;
927 1064
1065=back
1066
1067=cut
1068
1069package AnyEvent::Log;
1070
1071=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
1072
1073Logging can also be configured by setting the environment variable
1074C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
1075
1076The value consists of one or more logging context specifications separated
1077by C<:> or whitespace. Each logging specification in turn starts with a
1078context name, followed by C<=>, followed by zero or more comma-separated
1079configuration directives, here are some examples:
1080
1081 # set default logging level
1082 filter=warn
1083
1084 # log to file instead of to stderr
1085 log=file=/tmp/mylog
1086
1087 # log to file in addition to stderr
1088 log=+%file:%file=file=/tmp/mylog
1089
1090 # enable debug log messages, log warnings and above to syslog
1091 filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
1092
1093 # log trace messages (only) from AnyEvent::Debug to file
1094 AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
1095
1096A context name in the log specification can be any of the following:
1097
1098=over 4
1099
1100=item C<collect>, C<filter>, C<log>
1101
1102Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
1103C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
1104
1105=item C<%name>
1106
1107Context names starting with a C<%> are anonymous contexts created when the
1108name is first mentioned. The difference to package contexts is that by
1109default they have no attached slaves.
1110
1111=item a perl package name
1112
1113Any other string references the logging context associated with the given
1114Perl C<package>. In the unlikely case where you want to specify a package
1115context that matches on of the other context name forms, you can add a
1116C<::> to the package name to force interpretation as a package.
1117
1118=back
1119
1120The configuration specifications can be any number of the following:
1121
1122=over 4
1123
1124=item C<stderr>
1125
1126Configures the context to use Perl's C<warn> function (which typically
1127logs to C<STDERR>). Works like C<log_to_warn>.
1128
1129=item C<file=>I<path>
1130
1131Configures the context to log to a file with the given path. Works like
1132C<log_to_file>.
1133
1134=item C<path=>I<path>
1135
1136Configures the context to log to a file with the given path. Works like
1137C<log_to_path>.
1138
1139=item C<syslog> or C<syslog=>I<expr>
1140
1141Configures the context to log to syslog. If I<expr> is given, then it is
1142evaluated in the L<Sys::Syslog> package, so you could use:
1143
1144 log=syslog=LOG_LOCAL0
1145
1146=item C<nolog>
1147
1148Configures the context to not log anything by itself, which is the
1149default. Same as C<< $ctx->log_cb (undef) >>.
1150
1151=item C<cap=>I<level>
1152
1153Caps logging messages entering this context at the given level, i.e.
1154reduces the priority of messages with higher priority than this level. The
1155default is C<0> (or C<off>), meaning the priority will not be touched.
1156
1157=item C<0> or C<off>
1158
1159Sets the logging level of the context to C<0>, i.e. all messages will be
1160filtered out.
1161
1162=item C<all>
1163
1164Enables all logging levels, i.e. filtering will effectively be switched
1165off (the default).
1166
1167=item C<only>
1168
1169Disables all logging levels, and changes the interpretation of following
1170level specifications to enable the specified level only.
1171
1172Example: only enable debug messages for a context.
1173
1174 context=only,debug
1175
1176=item C<except>
1177
1178Enables all logging levels, and changes the interpretation of following
1179level specifications to disable that level. Rarely used.
1180
1181Example: enable all logging levels except fatal and trace (this is rather
1182nonsensical).
1183
1184 filter=exept,fatal,trace
1185
1186=item C<level>
1187
1188Enables all logging levels, and changes the interpretation of following
1189level specifications to be "that level or any higher priority
1190message". This is the default.
1191
1192Example: log anything at or above warn level.
1193
1194 filter=warn
1195
1196 # or, more verbose
1197 filter=only,level,warn
1198
1199=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
1200
1201A numeric loglevel or the name of a loglevel will be interpreted according
1202to the most recent C<only>, C<except> or C<level> directive. By default,
1203specifying a logging level enables that and any higher priority messages.
1204
1205=item C<+>I<context>
1206
1207Attaches the named context as slave to the context.
1208
1209=item C<+>
1210
1211A lone C<+> detaches all contexts, i.e. clears the slave list from the
1212context. Anonymous (C<%name>) contexts have no attached slaves by default,
1213but package contexts have the parent context as slave by default.
1214
1215Example: log messages from My::Module to a file, do not send them to the
1216default log collector.
1217
1218 My::Module=+,file=/tmp/mymodulelog
1219
1220=back
1221
1222Any character can be escaped by prefixing it with a C<\> (backslash), as
1223usual, so to log to a file containing a comma, colon, backslash and some
1224spaces in the filename, you would do this:
1225
1226 PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
1227
1228Since whitespace (which includes newlines) is allowed, it is fine to
1229specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
1230
1231 PERL_ANYEVENT_LOG="
1232 filter=warn
1233 AnyEvent::Debug=+%trace
1234 %trace=only,trace,+log
1235 " myprog
1236
1237Also, in the unlikely case when you want to concatenate specifications,
1238use whitespace as separator, as C<::> will be interpreted as part of a
1239module name, an empty spec with two separators:
1240
1241 PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
1242
1243=cut
1244
1245for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1246 my %anon;
1247
1248 my $pkg = sub {
1249 $_[0] eq "log" ? $LOG
1250 : $_[0] eq "filter" ? $FILTER
1251 : $_[0] eq "collect" ? $COLLECT
1252 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1253 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1254 : die # never reached?
1255 };
1256
1257 /\G[[:space:]]+/gc; # skip initial whitespace
1258
1259 while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
1260 my $ctx = $pkg->($1);
1261 my $level = "level";
1262
1263 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1264 for ("$1") {
1265 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1266 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1267 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1268 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1269 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1270 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1271 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1272 } elsif ($_ eq "+" ) { $ctx->slaves;
1273 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1274 } elsif ($_ eq "all" ) { $ctx->level ("all");
1275 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1276 } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
1277 } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
1278 } elsif (/^\d$/ ) { $ctx->$level ($_);
1279 } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
1280 } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
1281 }
1282 }
1283
1284 /\G,/gc or last;
1285 }
1286
1287 /\G[:[:space:]]+/gc or last;
1288 }
1289
1290 /\G[[:space:]]+/gc; # skip trailing whitespace
1291
1292 if (/\G(.+)/g) {
1293 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1294 }
1295}
1296
9281; 12971;
929 1298
930=back
931
932=head1 EXAMPLES 1299=head1 EXAMPLES
933 1300
934This section shows some common configurations. 1301This section shows some common configurations, both as code, and as
1302C<PERL_ANYEVENT_LOG> string.
935 1303
936=over 4 1304=over 4
937 1305
938=item Setting the global logging level. 1306=item Setting the global logging level.
939 1307
940Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before 1308Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
941running your program, or modify the log level of the root context: 1309running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
1310the root context at runtime:
942 1311
943 PERL_ANYEVENT_VERBOSE=5 ./myprog 1312 PERL_ANYEVENT_VERBOSE=5 ./myprog
944 1313
1314 PERL_ANYEVENT_LOG=log=warn
1315
945 $AnyEvent::Log::FILTER->level ("warn"); 1316 $AnyEvent::Log::FILTER->level ("warn");
946 1317
947=item Append all messages to a file instead of sending them to STDERR. 1318=item Append all messages to a file instead of sending them to STDERR.
948 1319
949This is affected by the global logging level. 1320This is affected by the global logging level.
950 1321
951 $AnyEvent::Log::LOG->log_to_file ($path); (sub { 1322 $AnyEvent::Log::LOG->log_to_file ($path);
1323
1324 PERL_ANYEVENT_LOG=log=file=/some/path
952 1325
953=item Write all messages with priority C<error> and higher to a file. 1326=item Write all messages with priority C<error> and higher to a file.
954 1327
955This writes them only when the global logging level allows it, because 1328This writes them only when the global logging level allows it, because
956it is attached to the default context which is invoked I<after> global 1329it is attached to the default context which is invoked I<after> global
957filtering. 1330filtering.
958 1331
959 $AnyEvent::Log::FILTER->attach 1332 $AnyEvent::Log::FILTER->attach (
960 new AnyEvent::Log::Ctx log_to_file => $path); 1333 new AnyEvent::Log::Ctx log_to_file => $path);
1334
1335 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
961 1336
962This writes them regardless of the global logging level, because it is 1337This writes them regardless of the global logging level, because it is
963attached to the toplevel context, which receives all messages I<before> 1338attached to the toplevel context, which receives all messages I<before>
964the global filtering. 1339the global filtering.
965 1340
966 $AnyEvent::Log::COLLECT->attach ( 1341 $AnyEvent::Log::COLLECT->attach (
967 new AnyEvent::Log::Ctx log_to_file => $path); 1342 new AnyEvent::Log::Ctx log_to_file => $path);
968 1343
1344 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1345
969In both cases, messages are still written to STDERR. 1346In both cases, messages are still written to STDERR.
1347
1348=item Additionally log all messages with C<warn> and higher priority to
1349C<syslog>, but cap at C<error>.
1350
1351This logs all messages to the default log target, but also logs messages
1352with priority C<warn> or higher (and not filtered otherwise) to syslog
1353facility C<user>. Messages with priority higher than C<error> will be
1354logged with level C<error>.
1355
1356 $AnyEvent::Log::LOG->attach (
1357 new AnyEvent::Log::Ctx
1358 level => "warn",
1359 cap => "error",
1360 syslog => "user",
1361 );
1362
1363 PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog
970 1364
971=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). 1365=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
972 1366
973Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1367Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
974context - this simply circumvents the global filtering for trace messages. 1368context - this simply circumvents the global filtering for trace messages.
975 1369
976 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx; 1370 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
977 $debug->attach ($AnyEvent::Log::LOG); 1371 $debug->attach ($AnyEvent::Log::LOG);
1372
1373 PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
978 1374
979This of course works for any package, not just L<AnyEvent::Debug>, but 1375This of course works for any package, not just L<AnyEvent::Debug>, but
980assumes the log level for AnyEvent::Debug hasn't been changed from the 1376assumes the log level for AnyEvent::Debug hasn't been changed from the
981default. 1377default.
982 1378
… …
986 1382
987 Marc Lehmann <schmorp@schmorp.de> 1383 Marc Lehmann <schmorp@schmorp.de>
988 http://home.schmorp.de/ 1384 http://home.schmorp.de/
989 1385
990=cut 1386=cut
1387

Diff Legend

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