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.51 by root, Thu Mar 22 18:00:35 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 use AnyEvent; 9 use AnyEvent;
9 10
10 AE::log debug => "hit my knee"; 11 AE::log fatal => "no config found, cannot continue"; # never returns
11 AE::log warn => "it's a bit too hot"; 12 AE::log alert => "the battery died";
12 AE::log error => "the flag was false!"; 13 AE::log crit => "the battery temperature is too hot";
13 AE::log fatal => "the bit toggled! run!"; 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";
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
37AnyEvent - AnyEvent simply creates logging messages internally, and this 62AnyEvent - AnyEvent simply creates logging messages internally, and this
38module 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
39using it from other modules as well. 64using it from other modules as well.
40 65
41Remember 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
42will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number 67errors and more important messages will be logged, unless you set
43before starting your program, or change the logging level at runtime with 68C<PERL_ANYEVENT_VERBOSE> to a higher number before starting your program
44something like: 69(C<AE_VERBOSE=5> is recommended during development), or change the logging
70level at runtime with something like:
45 71
46 use AnyEvent::Log; 72 use AnyEvent::Log;
47 AnyEvent::Log::FILTER->level ("info"); 73 $AnyEvent::Log::FILTER->level ("info");
48 74
49The 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),
50but 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
51extensive enough for the most common tasks, such as logging to multiple 77extensive enough for the most common tasks, such as logging to multiple
52targets, or being able to log into a database. 78targets, or being able to log into a database.
53 79
80The module is also usable before AnyEvent itself is initialised, in which
81case some of the functionality might be reduced.
82
54The amount of documentation might indicate otherwise, but the module is 83The amount of documentation might indicate otherwise, but the runtime part
55still just below 300 lines of code. 84of the module is still just below 300 lines of code.
56 85
57=head1 LOGGING LEVELS 86=head1 LOGGING LEVELS
58 87
59Logging 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>
60(lowest priority). Note that the lowest numerical value is the highest 89(lowest priority). Note that the lowest numerical value is the highest
… …
62numerical value". 91numerical value".
63 92
64Instead 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:
65 94
66 LVL NAME SYSLOG PERL NOTE 95 LVL NAME SYSLOG PERL NOTE
67 1 fatal emerg exit aborts program! 96 1 fatal emerg exit system unusable, aborts program!
68 2 alert 97 2 alert failure in primary system
69 3 critical crit 98 3 critical crit failure in backup system
70 4 error err die 99 4 error err die non-urgent program errors, a bug
71 5 warn warning 100 5 warn warning possible problem, not necessarily error
72 6 note notice 101 6 note notice unusual conditions
73 7 info 102 7 info normal messages, no action required
74 8 debug 103 8 debug debugging messages for development
75 9 trace 104 9 trace copious tracing output
76 105
77As 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
78is 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)
79and 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>
80at C<error> priority. 109messages at C<error> priority. The NOTE column tries to provide some
110rationale on how to chose a logging level.
81 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
82You 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>,
83(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
84program - 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.
85 124
86Some 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>
87or 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.
88 127
89=head1 LOGGING FUNCTIONS 128=head1 LOGGING FUNCTIONS
90 129
91These functions allow you to log messages. They always use the caller's 130The following functions allow you to log messages. They always use the
92package as a "logging context". Also, the main logging function C<log> is 131caller's package as a "logging context". Also, the main logging function,
93callable 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>
94loaded. 133module is loaded.
95 134
96=over 4 135=over 4
97 136
98=cut 137=cut
99 138
100package AnyEvent::Log; 139package AnyEvent::Log;
101 140
102use Carp (); 141use Carp ();
103use POSIX (); 142use POSIX ();
104 143
144# layout of a context
145# 0 1 2 3 4, 5
146# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
147
105use AnyEvent (); BEGIN { AnyEvent::common_sense } 148use AnyEvent (); BEGIN { AnyEvent::common_sense }
106use AnyEvent::Util (); 149#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
107 150
108our $VERSION = $AnyEvent::VERSION; 151our $VERSION = $AnyEvent::VERSION;
109 152
110our ($COLLECT, $FILTER, $LOG); 153our ($COLLECT, $FILTER, $LOG);
111 154
… …
138 $ctx 181 $ctx
139} 182}
140 183
141=item AnyEvent::Log::log $level, $msg[, @args] 184=item AnyEvent::Log::log $level, $msg[, @args]
142 185
143Requests logging of the given C<$msg> with the given log level. 186Requests logging of the given C<$msg> with the given log level, and
187returns true if the message was logged I<somewhere>.
144 188
145For C<fatal> log levels, the program will abort. 189For loglevel C<fatal>, the program will abort.
146 190
147If 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
148C<$msg> is interpreted as an sprintf format string. 192C<$msg> is interpreted as an sprintf format string.
149 193
150The 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
… …
153Last 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
154supposed 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
155actually 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
156message in the first place. 200message in the first place.
157 201
202This function takes care of saving and restoring C<$!> and C<$@>, so you
203don't have to.
204
158Whether 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
159and the caller's package. 206and the caller's package. The return value can be used to ensure that
207messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
208runtime error it tries to log it at C<die> level, but if that message is
209lost it simply uses warn.
160 210
161Note that you can (and should) call this function as C<AnyEvent::log> or 211Note 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 212C<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 213need any additional functionality), as those functions will load the
164logging module on demand only. They are also much shorter to write. 214logging module on demand only. They are also much shorter to write.
… …
192 info => 7, 242 info => 7,
193 debug => 8, 243 debug => 8,
194 trace => 9, 244 trace => 9,
195); 245);
196 246
197sub 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}
198 259
199AnyEvent::post_detect { 260AnyEvent::post_detect {
200 *now = \&AE::now; 261 exact_time $TIME_EXACT;
201}; 262};
202 263
203our @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);
204 265
205# time, ctx, level, msg 266# time, ctx, level, msg
… …
215 } 276 }
216 277
217 join "", @res 278 join "", @res
218} 279}
219 280
281sub fatal_exit() {
282 exit 1;
283}
284
220sub _log { 285sub _log {
221 my ($ctx, $level, $format, @args) = @_; 286 my ($ctx, $level, $format, @args) = @_;
222 287
223 $level = $level > 0 && $level <= 9 288 $level = $level > 0 && $level <= 9
224 ? $level+0 289 ? $level+0
225 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 290 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
226 291
227 my $mask = 1 << $level; 292 my $mask = 1 << $level;
228 293
229 my (%seen, @ctx, $now, $fmt); 294 my ($success, %seen, @ctx, $now, @fmt);
230 295
231 do 296 do
232 { 297 {
233 # skip if masked 298 # if !ref, then it's a level number
299 if (!ref $ctx) {
300 $level = $ctx;
234 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
235 if ($ctx->[3]) { 311 if ($ctx->[3]) {
236 # logging target found 312 # logging target found
313
314 local ($!, $@);
237 315
238 # now get raw message, unless we have it already 316 # now get raw message, unless we have it already
239 unless ($now) { 317 unless ($now) {
240 $format = $format->() if ref $format; 318 $format = $format->() if ref $format;
241 $format = sprintf $format, @args if @args; 319 $format = sprintf $format, @args if @args;
242 $format =~ s/\n$//; 320 $format =~ s/\n$//;
243 $now = AE::now; 321 $now = _ts;
244 }; 322 };
245 323
246 # format msg 324 # format msg
247 my $str = $ctx->[4] 325 my $str = $ctx->[4]
248 ? $ctx->[4]($now, $_[0], $level, $format) 326 ? $ctx->[4]($now, $_[0], $level, $format)
249 : ($fmt ||= _format $now, $_[0], $level, $format); 327 : ($fmt[$level] ||= _format $now, $_[0], $level, $format);
250 328
329 $success = 1;
330
251 $ctx->[3]($str, $_[0], $level) 331 $ctx->[3]($str)
252 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 332 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
253 } else { 333 } else {
254 push @ctx, values %{ $ctx->[2] }; # not masked - propagate 334 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
255 } 335 }
256 } 336 }
257 } 337 }
258 while $ctx = pop @ctx; 338 while $ctx = pop @ctx;
259 339
260 exit 1 if $level <= 1; 340 fatal_exit if $level <= 1;
341
342 $success
261} 343}
262 344
263sub log($$;@) { 345sub log($$;@) {
264 _log 346 _log
265 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 347 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
266 @_; 348 @_;
267} 349}
268 350
269*AnyEvent::log = *AE::log = \&log;
270
271=item $logger = AnyEvent::Log::logger $level[, \$enabled] 351=item $logger = AnyEvent::Log::logger $level[, \$enabled]
272 352
273Creates a code reference that, when called, acts as if the 353Creates a code reference that, when called, acts as if the
274C<AnyEvent::Log::log> function was called at this point with the givne 354C<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 355level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
276the C<AnyEvent::Log::log> function: 356the C<AnyEvent::Log::log> function:
277 357
278 my $debug_log = AnyEvent::Log::logger "debug"; 358 my $debug_log = AnyEvent::Log::logger "debug";
279 359
… …
339 419
340 $LOGGER{$logger+0} = $logger; 420 $LOGGER{$logger+0} = $logger;
341 421
342 _reassess $logger+0; 422 _reassess $logger+0;
343 423
424 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
344 my $guard = AnyEvent::Util::guard { 425 my $guard = AnyEvent::Util::guard (sub {
345 # "clean up" 426 # "clean up"
346 delete $LOGGER{$logger+0}; 427 delete $LOGGER{$logger+0};
347 }; 428 });
348 429
349 sub { 430 sub {
350 $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
351 432
352 _log $ctx, $level, @_ 433 _log $ctx, $level, @_
… …
357sub logger($;$) { 438sub logger($;$) {
358 _logger 439 _logger
359 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 440 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
360 @_ 441 @_
361} 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.
362 458
363=back 459=back
364 460
365=head1 LOGGING CONTEXTS 461=head1 LOGGING CONTEXTS
366 462
… …
486This 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
487configuration, reset all contexts. 583configuration, reset all contexts.
488 584
489=cut 585=cut
490 586
587our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
588$AnyEvent::VERBOSE = 9;
589
491sub reset { 590sub reset {
492 # hard to kill complex data structures 591 # hard to kill complex data structures
493 # we "recreate" all package loggers and reset the hierarchy 592 # we "recreate" all package loggers and reset the hierarchy
494 while (my ($k, $v) = each %CTX) { 593 while (my ($k, $v) = each %CTX) {
495 @$v = ($k, (1 << 10) - 1 - 1, { }); 594 @$v = ($k, (1 << 10) - 1 - 1, { });
… …
498 } 597 }
499 598
500 @$_ = ($_->[0], (1 << 10) - 1 - 1) 599 @$_ = ($_->[0], (1 << 10) - 1 - 1)
501 for $LOG, $FILTER, $COLLECT; 600 for $LOG, $FILTER, $COLLECT;
502 601
503 $LOG->slaves; 602 #$LOG->slaves;
504 $LOG->title ('$AnyEvent::Log::LOG'); 603 $LOG->title ('$AnyEvent::Log::LOG');
505 $LOG->log_cb (sub { 604 $LOG->log_to_warn;
506 warn shift;
507 0
508 });
509 605
510 $FILTER->slaves ($LOG); 606 $FILTER->slaves ($LOG);
511 $FILTER->title ('$AnyEvent::Log::FILTER'); 607 $FILTER->title ('$AnyEvent::Log::FILTER');
512 $FILTER->level ($AnyEvent::VERBOSE); 608 $FILTER->level ($ORIG_VERBOSE);
513 609
514 $COLLECT->slaves ($FILTER); 610 $COLLECT->slaves ($FILTER);
515 $COLLECT->title ('$AnyEvent::Log::COLLECT'); 611 $COLLECT->title ('$AnyEvent::Log::COLLECT');
516 612
517 _reassess; 613 _reassess;
518} 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;
519 623
520# create the default logger contexts 624# create the default logger contexts
521$LOG = ctx undef; 625$LOG = ctx undef;
522$FILTER = ctx undef; 626$FILTER = ctx undef;
523$COLLECT = ctx undef; 627$COLLECT = ctx undef;
… …
532package AnyEvent::Log::COLLECT; 636package AnyEvent::Log::COLLECT;
533package AE::Log::COLLECT; 637package AE::Log::COLLECT;
534 638
535package AnyEvent::Log::Ctx; 639package AnyEvent::Log::Ctx;
536 640
537# 0 1 2 3 4
538# [$title, $level, %$slaves, &$logcb, &$fmtcb]
539
540=item $ctx = new AnyEvent::Log::Ctx methodname => param... 641=item $ctx = new AnyEvent::Log::Ctx methodname => param...
541 642
542This is a convenience constructor that makes it simpler to construct 643This is a convenience constructor that makes it simpler to construct
543anonymous logging contexts. 644anonymous logging contexts.
544 645
… …
631 732
632=item $ctx->disable ($level[, $level...]) 733=item $ctx->disable ($level[, $level...])
633 734
634Disables logging for the given levels, leaving all others unchanged. 735Disables logging for the given levels, leaving all others unchanged.
635 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
636=cut 759=cut
637 760
638sub _lvl_lst { 761sub _lvl_lst {
639 map { 762 map {
640 $_ > 0 && $_ <= 9 ? $_+0 763 $_ > 0 && $_ <= 9 ? $_+0
641 : $_ eq "all" ? (1 .. 9) 764 : $_ eq "all" ? (1 .. 9)
642 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 765 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
643 } @_ 766 } @_
644} 767}
645 768
769sub _lvl {
770 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
771}
772
646our $NOP_CB = sub { 0 }; 773our $NOP_CB = sub { 0 };
647 774
648sub levels { 775sub levels {
649 my $ctx = shift; 776 my $ctx = shift;
650 $ctx->[1] = 0; 777 $ctx->[1] = 0;
… …
653 AnyEvent::Log::_reassess; 780 AnyEvent::Log::_reassess;
654} 781}
655 782
656sub level { 783sub level {
657 my $ctx = shift; 784 my $ctx = shift;
658 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
659
660 $ctx->[1] = ((1 << $lvl) - 1) << 1; 785 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
661 AnyEvent::Log::_reassess; 786 AnyEvent::Log::_reassess;
662} 787}
663 788
664sub enable { 789sub enable {
665 my $ctx = shift; 790 my $ctx = shift;
… …
673 $ctx->[1] &= ~(1 << $_) 798 $ctx->[1] &= ~(1 << $_)
674 for &_lvl_lst; 799 for &_lvl_lst;
675 AnyEvent::Log::_reassess; 800 AnyEvent::Log::_reassess;
676} 801}
677 802
803sub cap {
804 my $ctx = shift;
805 $ctx->[5] = &_lvl;
806}
807
678=back 808=back
679 809
680=head3 SLAVE CONTEXTS 810=head3 SLAVE CONTEXTS
681 811
682The following methods attach and detach another logging context to a 812The following methods attach and detach another logging context to a
… …
734the logging (which consists of formatting the message and printing it or 864the logging (which consists of formatting the message and printing it or
735whatever it wants to do with it). 865whatever it wants to do with it).
736 866
737=over 4 867=over 4
738 868
739=item $ctx->log_cb ($cb->($str, $orig_ctx, $level)) 869=item $ctx->log_cb ($cb->($str)
740 870
741Replaces the logging callback on the context (C<undef> disables the 871Replaces the logging callback on the context (C<undef> disables the
742logging callback). 872logging callback).
743 873
744The logging callback is responsible for handling formatted log messages 874The logging callback is responsible for handling formatted log messages
745(see C<fmt_cb> below) - normally simple text strings that end with a 875(see C<fmt_cb> below) - normally simple text strings that end with a
746newline (and are possibly multiline themselves). In addition to the 876newline (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 877
750It also has to return true iff it has consumed the log message, and false 878It 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 879if 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. 880slave context. When in doubt, return C<0> from your logging callback.
753 881
… …
765your program. 893your program.
766 894
767 $ctx->levels ("debug", "trace"); 895 $ctx->levels ("debug", "trace");
768 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages 896 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
769 897
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
793=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message)) 898=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
794 899
795Replaces the formatting callback on the context (C<undef> restores the 900Replaces the formatting callback on the context (C<undef> restores the
796default formatter). 901default formatter).
797 902
798The callback is passed the (possibly fractional) timestamp, the original 903The callback is passed the (possibly fractional) timestamp, the original
799logging context, the (numeric) logging level and the raw message string 904logging context (object, not title), the (numeric) logging level and
800and 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
801string, 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
802the values. 907reference that just stores the values.
803 908
804If, 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
805logger 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
806inside the C<AnyEvent::Log> package. 911inside the C<AnyEvent::Log> package.
807 912
808Example: format just the raw message, with numeric log level in angle 913Example: format just the raw message, with numeric log level in angle
809brackets. 914brackets.
… …
813 918
814 "<$lvl>$msg\n" 919 "<$lvl>$msg\n"
815 }); 920 });
816 921
817Example: return an array reference with just the log values, and use 922Example: return an array reference with just the log values, and use
818C<PApp::SQL::sql_exec> to store the emssage in a database. 923C<PApp::SQL::sql_exec> to store the message in a database.
819 924
820 $ctx->fmt_cb (sub { \@_ }); 925 $ctx->fmt_cb (sub { \@_ });
821 $ctx->log_cb (sub { 926 $ctx->log_cb (sub {
822 my ($msg) = @_; 927 my ($msg) = @_;
823 928
… …
828 "$msg->[3]"; 933 "$msg->[3]";
829 934
830 0 935 0
831 }); 936 });
832 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
943=item $ctx->log_to_file ($path)
944
945Sets the C<log_cb> to log to a file (by appending), unbuffered.
946
947=item $ctx->log_to_path ($path)
948
949Same as C<< ->log_to_file >>, but opens the file for each message. This
950is much slower, but allows you to change/move/rename/delete the file at
951basically any time.
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
957=item $ctx->log_to_syslog ([$facility])
958
959Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
960all the others in the obvious way. If specified, then the C<$facility> is
961used as the facility (C<user>, C<auth>, C<local0> and so on). The default
962facility is C<user>.
963
964Note that this function also sets a C<fmt_cb> - the logging part requires
965an array reference with [$level, $str] as input.
966
833=cut 967=cut
834 968
835sub log_cb { 969sub log_cb {
836 my ($ctx, $cb) = @_; 970 my ($ctx, $cb) = @_;
837 971
… …
840 974
841sub fmt_cb { 975sub fmt_cb {
842 my ($ctx, $cb) = @_; 976 my ($ctx, $cb) = @_;
843 977
844 $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 });
845} 988}
846 989
847sub log_to_file { 990sub log_to_file {
848 my ($ctx, $path) = @_; 991 my ($ctx, $path) = @_;
849 992
… …
854 syswrite $fh, shift; 997 syswrite $fh, shift;
855 0 998 0
856 }); 999 });
857} 1000}
858 1001
859sub log_to_file { 1002sub log_to_path {
860 my ($ctx, $path) = @_; 1003 my ($ctx, $path) = @_;
861 1004
862 $ctx->log_cb (sub { 1005 $ctx->log_cb (sub {
863 open my $fh, ">>", $path 1006 open my $fh, ">>", $path
864 or die "$path: $!"; 1007 or die "$path: $!";
… …
867 0 1010 0
868 }); 1011 });
869} 1012}
870 1013
871sub log_to_syslog { 1014sub log_to_syslog {
872 my ($ctx, $flags) = @_; 1015 my ($ctx, $facility) = @_;
873 1016
874 require Sys::Syslog; 1017 require Sys::Syslog;
875 1018
1019 $ctx->fmt_cb (sub {
1020 my $str = $_[3];
1021 $str =~ s/\n(?=.)/\n+ /g;
1022
1023 [$_[2], "($_[1][0]) $str"]
1024 });
1025
1026 $facility ||= "user";
1027
876 $ctx->log_cb (sub { 1028 $ctx->log_cb (sub {
877 my $lvl = $_[2] < 9 ? $_[2] : 8; 1029 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
878 1030
879 Sys::Syslog::syslog ($flags | ($lvl - 1), $_) 1031 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
880 for split /\n/, shift; 1032 for split /\n/, $_[0][1];
881 1033
882 0 1034 0
883 }); 1035 });
884} 1036}
885 1037
… …
904=cut 1056=cut
905 1057
906*log = \&AnyEvent::Log::_log; 1058*log = \&AnyEvent::Log::_log;
907*logger = \&AnyEvent::Log::_logger; 1059*logger = \&AnyEvent::Log::_logger;
908 1060
1061=back
1062
1063=cut
1064
1065package AnyEvent::Log;
1066
1067=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
1068
1069Logging can also be configured by setting the environment variable
1070C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
1071
1072The value consists of one or more logging context specifications separated
1073by C<:> or whitespace. Each logging specification in turn starts with a
1074context name, followed by C<=>, followed by zero or more comma-separated
1075configuration directives, here are some examples:
1076
1077 # set default logging level
1078 filter=warn
1079
1080 # log to file instead of to stderr
1081 log=file=/tmp/mylog
1082
1083 # log to file in addition to stderr
1084 log=+%file:%file=file=/tmp/mylog
1085
1086 # enable debug log messages, log warnings and above to syslog
1087 filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
1088
1089 # log trace messages (only) from AnyEvent::Debug to file
1090 AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
1091
1092A context name in the log specification can be any of the following:
1093
1094=over 4
1095
1096=item C<collect>, C<filter>, C<log>
1097
1098Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
1099C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
1100
1101=item C<%name>
1102
1103Context names starting with a C<%> are anonymous contexts created when the
1104name is first mentioned. The difference to package contexts is that by
1105default they have no attached slaves.
1106
1107=item a perl package name
1108
1109Any other string references the logging context associated with the given
1110Perl C<package>. In the unlikely case where you want to specify a package
1111context that matches on of the other context name forms, you can add a
1112C<::> to the package name to force interpretation as a package.
1113
1114=back
1115
1116The configuration specifications can be any number of the following:
1117
1118=over 4
1119
1120=item C<stderr>
1121
1122Configures the context to use Perl's C<warn> function (which typically
1123logs to C<STDERR>). Works like C<log_to_warn>.
1124
1125=item C<file=>I<path>
1126
1127Configures the context to log to a file with the given path. Works like
1128C<log_to_file>.
1129
1130=item C<path=>I<path>
1131
1132Configures the context to log to a file with the given path. Works like
1133C<log_to_path>.
1134
1135=item C<syslog> or C<syslog=>I<expr>
1136
1137Configures the context to log to syslog. If I<expr> is given, then it is
1138evaluated in the L<Sys::Syslog> package, so you could use:
1139
1140 log=syslog=LOG_LOCAL0
1141
1142=item C<nolog>
1143
1144Configures the context to not log anything by itself, which is the
1145default. Same as C<< $ctx->log_cb (undef) >>.
1146
1147=item C<cap=>I<level>
1148
1149Caps logging messages entering this context at the given level, i.e.
1150reduces the priority of messages with higher priority than this level. The
1151default is C<0> (or C<off>), meaning the priority will not be touched.
1152
1153=item C<0> or C<off>
1154
1155Sets the logging level of the context to C<0>, i.e. all messages will be
1156filtered out.
1157
1158=item C<all>
1159
1160Enables all logging levels, i.e. filtering will effectively be switched
1161off (the default).
1162
1163=item C<only>
1164
1165Disables all logging levels, and changes the interpretation of following
1166level specifications to enable the specified level only.
1167
1168Example: only enable debug messages for a context.
1169
1170 context=only,debug
1171
1172=item C<except>
1173
1174Enables all logging levels, and changes the interpretation of following
1175level specifications to disable that level. Rarely used.
1176
1177Example: enable all logging levels except fatal and trace (this is rather
1178nonsensical).
1179
1180 filter=exept,fatal,trace
1181
1182=item C<level>
1183
1184Enables all logging levels, and changes the interpretation of following
1185level specifications to be "that level or any higher priority
1186message". This is the default.
1187
1188Example: log anything at or above warn level.
1189
1190 filter=warn
1191
1192 # or, more verbose
1193 filter=only,level,warn
1194
1195=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
1196
1197A numeric loglevel or the name of a loglevel will be interpreted according
1198to the most recent C<only>, C<except> or C<level> directive. By default,
1199specifying a logging level enables that and any higher priority messages.
1200
1201=item C<+>I<context>
1202
1203Attaches the named context as slave to the context.
1204
1205=item C<+>
1206
1207A lone C<+> detaches all contexts, i.e. clears the slave list from the
1208context. Anonymous (C<%name>) contexts have no attached slaves by default,
1209but package contexts have the parent context as slave by default.
1210
1211Example: log messages from My::Module to a file, do not send them to the
1212default log collector.
1213
1214 My::Module=+,file=/tmp/mymodulelog
1215
1216=back
1217
1218Any character can be escaped by prefixing it with a C<\> (backslash), as
1219usual, so to log to a file containing a comma, colon, backslash and some
1220spaces in the filename, you would do this:
1221
1222 PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
1223
1224Since whitespace (which includes newlines) is allowed, it is fine to
1225specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
1226
1227 PERL_ANYEVENT_LOG="
1228 filter=warn
1229 AnyEvent::Debug=+%trace
1230 %trace=only,trace,+log
1231 " myprog
1232
1233Also, in the unlikely case when you want to concatenate specifications,
1234use whitespace as separator, as C<::> will be interpreted as part of a
1235module name, an empty spec with two separators:
1236
1237 PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
1238
1239=cut
1240
1241for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1242 my %anon;
1243
1244 my $pkg = sub {
1245 $_[0] eq "log" ? $LOG
1246 : $_[0] eq "filter" ? $FILTER
1247 : $_[0] eq "collect" ? $COLLECT
1248 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1249 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1250 : die # never reached?
1251 };
1252
1253 /\G[[:space:]]+/gc; # skip initial whitespace
1254
1255 while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
1256 my $ctx = $pkg->($1);
1257 my $level = "level";
1258
1259 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1260 for ("$1") {
1261 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1262 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1263 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1264 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1265 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1266 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1267 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1268 } elsif ($_ eq "+" ) { $ctx->slaves;
1269 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1270 } elsif ($_ eq "all" ) { $ctx->level ("all");
1271 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1272 } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
1273 } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
1274 } elsif (/^\d$/ ) { $ctx->$level ($_);
1275 } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
1276 } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
1277 }
1278 }
1279
1280 /\G,/gc or last;
1281 }
1282
1283 /\G[:[:space:]]+/gc or last;
1284 }
1285
1286 /\G[[:space:]]+/gc; # skip trailing whitespace
1287
1288 if (/\G(.+)/g) {
1289 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1290 }
1291}
1292
9091; 12931;
910 1294
911=back
912
913=head1 EXAMPLES 1295=head1 EXAMPLES
914 1296
915This section shows some common configurations. 1297This section shows some common configurations, both as code, and as
1298C<PERL_ANYEVENT_LOG> string.
916 1299
917=over 4 1300=over 4
918 1301
919=item Setting the global logging level. 1302=item Setting the global logging level.
920 1303
921Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before 1304Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
922running your program, or modify the log level of the root context: 1305running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
1306the root context at runtime:
923 1307
924 PERL_ANYEVENT_VERBOSE=5 ./myprog 1308 PERL_ANYEVENT_VERBOSE=5 ./myprog
925 1309
1310 PERL_ANYEVENT_LOG=log=warn
1311
926 $AnyEvent::Log::FILTER->level ("warn"); 1312 $AnyEvent::Log::FILTER->level ("warn");
927 1313
928=item Append all messages to a file instead of sending them to STDERR. 1314=item Append all messages to a file instead of sending them to STDERR.
929 1315
930This is affected by the global logging level. 1316This is affected by the global logging level.
931 1317
932 $AnyEvent::Log::LOG->log_to_file ($path); (sub { 1318 $AnyEvent::Log::LOG->log_to_file ($path);
1319
1320 PERL_ANYEVENT_LOG=log=file=/some/path
933 1321
934=item Write all messages with priority C<error> and higher to a file. 1322=item Write all messages with priority C<error> and higher to a file.
935 1323
936This writes them only when the global logging level allows it, because 1324This writes them only when the global logging level allows it, because
937it is attached to the default context which is invoked I<after> global 1325it is attached to the default context which is invoked I<after> global
938filtering. 1326filtering.
939 1327
940 $AnyEvent::Log::FILTER->attach 1328 $AnyEvent::Log::FILTER->attach (
941 new AnyEvent::Log::Ctx log_to_file => $path); 1329 new AnyEvent::Log::Ctx log_to_file => $path);
1330
1331 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
942 1332
943This writes them regardless of the global logging level, because it is 1333This writes them regardless of the global logging level, because it is
944attached to the toplevel context, which receives all messages I<before> 1334attached to the toplevel context, which receives all messages I<before>
945the global filtering. 1335the global filtering.
946 1336
947 $AnyEvent::Log::COLLECT->attach ( 1337 $AnyEvent::Log::COLLECT->attach (
948 new AnyEvent::Log::Ctx log_to_file => $path); 1338 new AnyEvent::Log::Ctx log_to_file => $path);
949 1339
1340 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1341
950In both cases, messages are still written to STDERR. 1342In both cases, messages are still written to STDERR.
1343
1344=item Additionally log all messages with C<warn> and higher priority to
1345C<syslog>, but cap at C<error>.
1346
1347This logs all messages to the default log target, but also logs messages
1348with priority C<warn> or higher (and not filtered otherwise) to syslog
1349facility C<user>. Messages with priority higher than C<error> will be
1350logged with level C<error>.
1351
1352 $AnyEvent::Log::LOG->attach (
1353 new AnyEvent::Log::Ctx
1354 level => "warn",
1355 cap => "error",
1356 syslog => "user",
1357 );
1358
1359 PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog
951 1360
952=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). 1361=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
953 1362
954Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1363Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
955context - this simply circumvents the global filtering for trace messages. 1364context - this simply circumvents the global filtering for trace messages.
956 1365
957 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx; 1366 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
958 $debug->attach ($AnyEvent::Log::LOG); 1367 $debug->attach ($AnyEvent::Log::LOG);
1368
1369 PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
959 1370
960This of course works for any package, not just L<AnyEvent::Debug>, but 1371This 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 1372assumes the log level for AnyEvent::Debug hasn't been changed from the
962default. 1373default.
963 1374
… …
967 1378
968 Marc Lehmann <schmorp@schmorp.de> 1379 Marc Lehmann <schmorp@schmorp.de>
969 http://home.schmorp.de/ 1380 http://home.schmorp.de/
970 1381
971=cut 1382=cut
1383

Diff Legend

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