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.38 by root, Fri Aug 26 00:32:45 2011 UTC vs.
Revision 1.73 by root, Sun Apr 24 21:22:38 2022 UTC

… …
6 6
7Simple uses: 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 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 => "Attempted 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
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
16"Complex" uses (for speed sensitive code): 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
25Configuration (also look at the EXAMPLES section): 43Configuration (also look at the EXAMPLES section):
26 44
45 # set default logging level to suppress anything below "notice"
46 # i.e. enable logging at "notice" or above - the default is to
47 # to not log anything at all.
48 $AnyEvent::Log::FILTER->level ("notice");
49
27 # set logging for the current package to errors and higher only 50 # set logging for the current package to errors and higher only
28 AnyEvent::Log::ctx->level ("error"); 51 AnyEvent::Log::ctx->level ("error");
29 52
30 # set logging level to suppress anything below "notice" 53 # enable logging for the current package, regardless of global logging level
31 $AnyEvent::Log::FILTER->level ("notice"); 54 AnyEvent::Log::ctx->attach ($AnyEvent::Log::LOG);
55
56 # enable debug logging for module some::mod and enable logging by default
57 (AnyEvent::Log::ctx "some::mod")->level ("debug");
58 (AnyEvent::Log::ctx "some::mod")->attach ($AnyEvent::Log::LOG);
32 59
33 # send all critical and higher priority messages to syslog, 60 # send all critical and higher priority messages to syslog,
34 # regardless of (most) other settings 61 # regardless of (most) other settings
35 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx 62 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
36 level => "critical", 63 level => "critical",
37 log_to_syslog => 0, 64 log_to_syslog => "user",
38 ); 65 );
39 66
40=head1 DESCRIPTION 67=head1 DESCRIPTION
41 68
42This module implements a relatively simple "logging framework". It doesn't 69This module implements a relatively simple "logging framework". It doesn't
43attempt to be "the" logging solution or even "a" logging solution for 70attempt to be "the" logging solution or even "a" logging solution for
44AnyEvent - AnyEvent simply creates logging messages internally, and this 71AnyEvent - AnyEvent simply creates logging messages internally, and this
45module more or less exposes the mechanism, with some extra spiff to allow 72module more or less exposes the mechanism, with some extra spiff to allow
46using it from other modules as well. 73using it from other modules as well.
47 74
48Remember that the default verbosity level is C<0> (C<off>), so nothing 75Remember that the default verbosity level is C<4> (C<error>), so only
49will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number 76errors and more important messages will be logged, unless you set
50before starting your program, or change the logging level at runtime with 77C<PERL_ANYEVENT_VERBOSE> to a higher number before starting your program
51something like: 78(C<AE_VERBOSE=5> is recommended during development), or change the logging
79level at runtime with something like:
52 80
53 use AnyEvent::Log; 81 use AnyEvent::Log;
54 $AnyEvent::Log::FILTER->level ("info"); 82 $AnyEvent::Log::FILTER->level ("info");
55 83
56The design goal behind this module was to keep it simple (and small), 84The design goal behind this module was to keep it simple (and small),
57but make it powerful enough to be potentially useful for any module, and 85but make it powerful enough to be potentially useful for any module,
58extensive enough for the most common tasks, such as logging to multiple 86and extensive enough for the most common tasks, such as logging to
59targets, or being able to log into a database. 87multiple targets, or being able to log into a database.
60 88
61The module is also usable before AnyEvent itself is initialised, in which 89The module is also usable before AnyEvent itself is initialised, in which
62case some of the functionality might be reduced. 90case some of the functionality might be reduced.
63 91
64The amount of documentation might indicate otherwise, but the runtime part 92The amount of documentation might indicate otherwise, but the runtime part
… …
72numerical value". 100numerical value".
73 101
74Instead of specifying levels by name you can also specify them by aliases: 102Instead of specifying levels by name you can also specify them by aliases:
75 103
76 LVL NAME SYSLOG PERL NOTE 104 LVL NAME SYSLOG PERL NOTE
77 1 fatal emerg exit aborts program! 105 1 fatal emerg exit system unusable, aborts program!
78 2 alert 106 2 alert failure in primary system
79 3 critical crit 107 3 critical crit failure in backup system
80 4 error err die 108 4 error err die non-urgent program errors, a bug
81 5 warn warning 109 5 warn warning possible problem, not necessarily error
82 6 note notice 110 6 note notice unusual conditions
83 7 info 111 7 info normal messages, no action required
84 8 debug 112 8 debug debugging messages for development
85 9 trace 113 9 trace copious tracing output
86 114
87As you can see, some logging levels have multiple aliases - the first one 115As you can see, some logging levels have multiple aliases - the first one
88is the "official" name, the second one the "syslog" name (if it differs) 116is the "official" name, the second one the "syslog" name (if it differs)
89and the third one the "perl" name, suggesting that you log C<die> messages 117and the third one the "perl" name, suggesting (only!) that you log C<die>
90at C<error> priority. 118messages at C<error> priority. The NOTE column tries to provide some
119rationale on how to chose a logging level.
91 120
121As a rough guideline, levels 1..3 are primarily meant for users of the
122program (admins, staff), and are the only ones logged to STDERR by
123default. Levels 4..6 are meant for users and developers alike, while
124levels 7..9 are usually meant for developers.
125
92You can normally only log a single message at highest priority level 126You can normally only log a message once at highest priority level (C<1>,
93(C<1>, C<fatal>), because logging a fatal message will also quit the 127C<fatal>), because logging a fatal message will also quit the program - so
94program - so use it sparingly :) 128use it sparingly :)
129
130For example, a program that finds an unknown switch on the commandline
131might well use a fatal logging level to tell users about it - the "system"
132in this case would be the program, or module.
95 133
96Some methods also offer some extra levels, such as C<0>, C<off>, C<none> 134Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
97or C<all> - these are only valid in the methods they are documented for. 135or C<all> - these are only valid for the methods that document them.
98 136
99=head1 LOGGING FUNCTIONS 137=head1 LOGGING FUNCTIONS
100 138
101These functions allow you to log messages. They always use the caller's 139The following functions allow you to log messages. They always use the
102package as a "logging context". Also, the main logging function C<log> is 140caller's package as a "logging context". Also, the main logging function,
103callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is 141C<log>, is aliased to C<AnyEvent::log> and C<AE::log> when the C<AnyEvent>
104loaded. 142module is loaded.
105 143
106=over 4 144=over 4
107 145
108=cut 146=cut
109 147
110package AnyEvent::Log; 148package AnyEvent::Log;
111 149
112use Carp (); 150use Carp ();
113use POSIX (); 151use POSIX ();
114 152
153# layout of a context
154# 0 1 2 3 4, 5
155# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
156
115use AnyEvent (); BEGIN { AnyEvent::common_sense } 157use AnyEvent (); BEGIN { AnyEvent::common_sense }
116#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log 158#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
117 159
118our $VERSION = $AnyEvent::VERSION; 160our $VERSION = $AnyEvent::VERSION;
119 161
120our ($COLLECT, $FILTER, $LOG); 162our ($COLLECT, $FILTER, $LOG);
121 163
122our ($now_int, $now_str1, $now_str2); 164our ($now_int, $now_str1, $now_str2);
123 165
124# Format Time, not public - yet? 166# Format Time, not public - yet?
125sub ft($) { 167sub format_time($) {
126 my $i = int $_[0]; 168 my $i = int $_[0];
127 my $f = sprintf "%06d", 1e6 * ($_[0] - $i); 169 my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
128 170
129 ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i) 171 ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i)
130 if $now_int != $i; 172 if $now_int != $i;
… …
151=item AnyEvent::Log::log $level, $msg[, @args] 193=item AnyEvent::Log::log $level, $msg[, @args]
152 194
153Requests logging of the given C<$msg> with the given log level, and 195Requests logging of the given C<$msg> with the given log level, and
154returns true if the message was logged I<somewhere>. 196returns true if the message was logged I<somewhere>.
155 197
156For C<fatal> log levels, the program will abort. 198For loglevel C<fatal>, the program will abort.
157 199
158If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the 200If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
159C<$msg> is interpreted as an sprintf format string. 201C<$msg> is interpreted as an sprintf format string.
160 202
161The C<$msg> should not end with C<\n>, but may if that is convenient for 203The C<$msg> should not end with C<\n>, but may if that is convenient for
… …
163 205
164Last not least, C<$msg> might be a code reference, in which case it is 206Last not least, C<$msg> might be a code reference, in which case it is
165supposed to return the message. It will be called only then the message 207supposed to return the message. It will be called only then the message
166actually gets logged, which is useful if it is costly to create the 208actually gets logged, which is useful if it is costly to create the
167message in the first place. 209message in the first place.
210
211This function takes care of saving and restoring C<$!> and C<$@>, so you
212don't have to.
168 213
169Whether the given message will be logged depends on the maximum log level 214Whether the given message will be logged depends on the maximum log level
170and the caller's package. The return value can be used to ensure that 215and the caller's package. The return value can be used to ensure that
171messages or not "lost" - for example, when L<AnyEvent::Debug> detects a 216messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
172runtime error it tries to log it at C<die> level, but if that message is 217runtime error it tries to log it at C<die> level, but if that message is
… …
226}; 271};
227 272
228our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 273our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
229 274
230# time, ctx, level, msg 275# time, ctx, level, msg
231sub _format($$$$) { 276sub default_format($$$$) {
232 my $ts = ft $_[0]; 277 my $ts = format_time $_[0];
233 my $ct = " "; 278 my $ct = " ";
234 279
235 my @res; 280 my @res;
236 281
237 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) { 282 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
… …
240 } 285 }
241 286
242 join "", @res 287 join "", @res
243} 288}
244 289
290sub fatal_exit() {
291 exit 1;
292}
293
245sub _log { 294sub _log {
246 my ($ctx, $level, $format, @args) = @_; 295 my ($ctx, $level, $format, @args) = @_;
247 296
248 $level = $level > 0 && $level <= 9 297 $level = $level > 0 && $level <= 9
249 ? $level+0 298 ? $level+0
250 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 299 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
251 300
252 my $mask = 1 << $level; 301 my $mask = 1 << $level;
253 302
254 my ($success, %seen, @ctx, $now, $fmt); 303 my ($success, %seen, @ctx, $now, @fmt);
255 304
256 do 305 do
257 { 306 {
258 # skip if masked 307 # if !ref, then it's a level number
308 if (!ref $ctx) {
309 $level = $ctx;
259 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) { 310 } elsif ($ctx->[1] & $mask and !$seen{$ctx+0}++) {
311 # logging/recursing into this context
312
313 # level cap
314 if ($ctx->[5] > $level) {
315 push @ctx, $level; # restore level when going up in tree
316 $level = $ctx->[5];
317 }
318
319 # log if log cb
260 if ($ctx->[3]) { 320 if ($ctx->[3]) {
261 # logging target found 321 # logging target found
322
323 local ($!, $@);
262 324
263 # now get raw message, unless we have it already 325 # now get raw message, unless we have it already
264 unless ($now) { 326 unless ($now) {
265 $format = $format->() if ref $format; 327 $format = $format->() if ref $format;
266 $format = sprintf $format, @args if @args; 328 $format = sprintf $format, @args if @args;
… …
269 }; 331 };
270 332
271 # format msg 333 # format msg
272 my $str = $ctx->[4] 334 my $str = $ctx->[4]
273 ? $ctx->[4]($now, $_[0], $level, $format) 335 ? $ctx->[4]($now, $_[0], $level, $format)
274 : ($fmt ||= _format $now, $_[0], $level, $format); 336 : ($fmt[$level] ||= default_format $now, $_[0], $level, $format);
275 337
276 $success = 1; 338 $success = 1;
277 339
278 $ctx->[3]($str) 340 $ctx->[3]($str)
279 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 341 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
… …
282 } 344 }
283 } 345 }
284 } 346 }
285 while $ctx = pop @ctx; 347 while $ctx = pop @ctx;
286 348
287 exit 1 if $level <= 1; 349 fatal_exit if $level <= 1;
288 350
289 $success 351 $success
290} 352}
291 353
292sub log($$;@) { 354sub log($$;@) {
293 _log 355 _log
294 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 356 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
295 @_; 357 @_;
296} 358}
297 359
298*AnyEvent::log = *AE::log = \&log;
299
300=item $logger = AnyEvent::Log::logger $level[, \$enabled] 360=item $logger = AnyEvent::Log::logger $level[, \$enabled]
301 361
302Creates a code reference that, when called, acts as if the 362Creates a code reference that, when called, acts as if the
303C<AnyEvent::Log::log> function was called at this point with the given 363C<AnyEvent::Log::log> function was called at this point with the given
304level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with 364level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
… …
368 428
369 $LOGGER{$logger+0} = $logger; 429 $LOGGER{$logger+0} = $logger;
370 430
371 _reassess $logger+0; 431 _reassess $logger+0;
372 432
373 require AnyEvent::Util; 433 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
374 my $guard = AnyEvent::Util::guard (sub { 434 my $guard = AnyEvent::Util::guard (sub {
375 # "clean up" 435 # "clean up"
376 delete $LOGGER{$logger+0}; 436 delete $LOGGER{$logger+0};
377 }); 437 });
378 438
… …
396eventloop time, for the log timestamps. After calling this function with a 456eventloop time, for the log timestamps. After calling this function with a
397true value it will instead resort to C<AE::time>, i.e. fetch the current 457true value it will instead resort to C<AE::time>, i.e. fetch the current
398time on each log message. This only makes a difference for event loops 458time on each log message. This only makes a difference for event loops
399that actually cache the time (such as L<EV> or L<AnyEvent::Loop>). 459that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
400 460
461This setting can be changed at any time by calling this function.
462
401Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been 463Since C<AnyEvent::Log> has to work even before L<AnyEvent> has been
402initialised, this switch will also decide whether to use C<CORE::time> or 464initialised, this switch will also decide whether to use C<CORE::time> or
403C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes 465C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
404available. 466available.
467
468=item AnyEvent::Log::format_time $timestamp
469
470Formats a timestamp as returned by C<< AnyEvent->now >> or C<<
471AnyEvent->time >> or many other functions in the same way as
472C<AnyEvent::Log> does.
473
474In your main program (as opposed to in your module) you can override
475the default timestamp display format by loading this module and then
476redefining this function.
477
478Most commonly, this function can be used in formatting callbacks.
479
480=item AnyEvent::Log::default_format $time, $ctx, $level, $msg
481
482Format a log message using the given timestamp, logging context, log level
483and log message.
484
485This is the formatting function used to format messages when no custom
486function is provided.
487
488In your main program (as opposed to in your module) you can override the
489default message format by loading this module and then redefining this
490function.
491
492=item AnyEvent::Log::fatal_exit()
493
494This is the function that is called after logging a C<fatal> log
495message. It must not return.
496
497The default implementation simply calls C<exit 1>.
498
499In your main program (as opposed to in your module) you can override
500the fatal exit function by loading this module and then redefining this
501function. Make sure you don't return.
405 502
406=back 503=back
407 504
408=head1 LOGGING CONTEXTS 505=head1 LOGGING CONTEXTS
409 506
… …
433context, so it does not matter (much) if there are cycles or if the 530context, so it does not matter (much) if there are cycles or if the
434message can arrive at the same context via multiple paths. 531message can arrive at the same context via multiple paths.
435 532
436=head2 DEFAULTS 533=head2 DEFAULTS
437 534
438By default, all logging contexts have an full set of log levels ("all"), a 535By default, all logging contexts have a full set of log levels ("all"), a
439disabled logging callback and the default formatting callback. 536disabled logging callback and the default formatting callback.
440 537
441Package contexts have the package name as logging title by default. 538Package contexts have the package name as logging title by default.
442 539
443They have exactly one slave - the context of the "parent" package. The 540They have exactly one slave - the context of the "parent" package. The
… …
497 594
498=item $ctx = AnyEvent::Log::ctx [$pkg] 595=item $ctx = AnyEvent::Log::ctx [$pkg]
499 596
500This function creates or returns a logging context (which is an object). 597This function creates or returns a logging context (which is an object).
501 598
502If a package name is given, then the context for that packlage is 599If a package name is given, then the context for that package is
503returned. If it is called without any arguments, then the context for the 600returned. If it is called without any arguments, then the context for the
504callers package is returned (i.e. the same context as a C<AE::log> call 601callers package is returned (i.e. the same context as a C<AE::log> call
505would use). 602would use).
506 603
507If C<undef> is given, then it creates a new anonymous context that is not 604If C<undef> is given, then it creates a new anonymous context that is not
… …
529This can be used to implement config-file (re-)loading: before loading a 626This can be used to implement config-file (re-)loading: before loading a
530configuration, reset all contexts. 627configuration, reset all contexts.
531 628
532=cut 629=cut
533 630
631our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
632$AnyEvent::VERBOSE = 9;
633
534sub reset { 634sub reset {
535 # hard to kill complex data structures 635 # hard to kill complex data structures
536 # we "recreate" all package loggers and reset the hierarchy 636 # we "recreate" all package loggers and reset the hierarchy
537 while (my ($k, $v) = each %CTX) { 637 while (my ($k, $v) = each %CTX) {
538 @$v = ($k, (1 << 10) - 1 - 1, { }); 638 @$v = ($k, (1 << 10) - 1 - 1, { });
… …
547 $LOG->title ('$AnyEvent::Log::LOG'); 647 $LOG->title ('$AnyEvent::Log::LOG');
548 $LOG->log_to_warn; 648 $LOG->log_to_warn;
549 649
550 $FILTER->slaves ($LOG); 650 $FILTER->slaves ($LOG);
551 $FILTER->title ('$AnyEvent::Log::FILTER'); 651 $FILTER->title ('$AnyEvent::Log::FILTER');
552 $FILTER->level ($AnyEvent::VERBOSE); 652 $FILTER->level ($ORIG_VERBOSE);
553 653
554 $COLLECT->slaves ($FILTER); 654 $COLLECT->slaves ($FILTER);
555 $COLLECT->title ('$AnyEvent::Log::COLLECT'); 655 $COLLECT->title ('$AnyEvent::Log::COLLECT');
556 656
557 _reassess; 657 _reassess;
558} 658}
659
660# override AE::log/logger
661*AnyEvent::log = *AE::log = \&log;
662*AnyEvent::logger = *AE::logger = \&logger;
663
664# convert AnyEvent loggers to AnyEvent::Log loggers
665$_->[0] = ctx $_->[0] # convert "pkg" to "ctx"
666 for values %LOGGER;
559 667
560# create the default logger contexts 668# create the default logger contexts
561$LOG = ctx undef; 669$LOG = ctx undef;
562$FILTER = ctx undef; 670$FILTER = ctx undef;
563$COLLECT = ctx undef; 671$COLLECT = ctx undef;
… …
572package AnyEvent::Log::COLLECT; 680package AnyEvent::Log::COLLECT;
573package AE::Log::COLLECT; 681package AE::Log::COLLECT;
574 682
575package AnyEvent::Log::Ctx; 683package AnyEvent::Log::Ctx;
576 684
577# 0 1 2 3 4
578# [$title, $level, %$slaves, &$logcb, &$fmtcb]
579
580=item $ctx = new AnyEvent::Log::Ctx methodname => param... 685=item $ctx = new AnyEvent::Log::Ctx methodname => param...
581 686
582This is a convenience constructor that makes it simpler to construct 687This is a convenience constructor that makes it simpler to construct
583anonymous logging contexts. 688anonymous logging contexts.
584 689
… …
671 776
672=item $ctx->disable ($level[, $level...]) 777=item $ctx->disable ($level[, $level...])
673 778
674Disables logging for the given levels, leaving all others unchanged. 779Disables logging for the given levels, leaving all others unchanged.
675 780
781=item $ctx->cap ($level)
782
783Caps the maximum priority to the given level, for all messages logged
784to, or passing through, this context. That is, while this doesn't affect
785whether a message is logged or passed on, the maximum priority of messages
786will be limited to the specified level - messages with a higher priority
787will be set to the specified priority.
788
789Another way to view this is that C<< ->level >> filters out messages with
790a too low priority, while C<< ->cap >> modifies messages with a too high
791priority.
792
793This is useful when different log targets have different interpretations
794of priority. For example, for a specific command line program, a wrong
795command line switch might well result in a C<fatal> log message, while the
796same message, logged to syslog, is likely I<not> fatal to the system or
797syslog facility as a whole, but more likely a mere C<error>.
798
799This can be modeled by having a stderr logger that logs messages "as-is"
800and a syslog logger that logs messages with a level cap of, say, C<error>,
801or, for truly system-critical components, actually C<critical>.
802
676=cut 803=cut
677 804
678sub _lvl_lst { 805sub _lvl_lst {
679 map { 806 map {
680 $_ > 0 && $_ <= 9 ? $_+0 807 $_ > 0 && $_ <= 9 ? $_+0
681 : $_ eq "all" ? (1 .. 9) 808 : $_ eq "all" ? (1 .. 9)
682 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 809 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
683 } @_ 810 } @_
684} 811}
685 812
813sub _lvl {
814 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
815}
816
686our $NOP_CB = sub { 0 }; 817our $NOP_CB = sub { 0 };
687 818
688sub levels { 819sub levels {
689 my $ctx = shift; 820 my $ctx = shift;
690 $ctx->[1] = 0; 821 $ctx->[1] = 0;
… …
693 AnyEvent::Log::_reassess; 824 AnyEvent::Log::_reassess;
694} 825}
695 826
696sub level { 827sub level {
697 my $ctx = shift; 828 my $ctx = shift;
698 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
699
700 $ctx->[1] = ((1 << $lvl) - 1) << 1; 829 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
701 AnyEvent::Log::_reassess; 830 AnyEvent::Log::_reassess;
702} 831}
703 832
704sub enable { 833sub enable {
705 my $ctx = shift; 834 my $ctx = shift;
… …
713 $ctx->[1] &= ~(1 << $_) 842 $ctx->[1] &= ~(1 << $_)
714 for &_lvl_lst; 843 for &_lvl_lst;
715 AnyEvent::Log::_reassess; 844 AnyEvent::Log::_reassess;
716} 845}
717 846
847sub cap {
848 my $ctx = shift;
849 $ctx->[5] = &_lvl;
850}
851
718=back 852=back
719 853
720=head3 SLAVE CONTEXTS 854=head3 SLAVE CONTEXTS
721 855
722The following methods attach and detach another logging context to a 856The following methods attach and detach another logging context to a
… …
750sub attach { 884sub attach {
751 my $ctx = shift; 885 my $ctx = shift;
752 886
753 $ctx->[2]{$_+0} = $_ 887 $ctx->[2]{$_+0} = $_
754 for map { AnyEvent::Log::ctx $_ } @_; 888 for map { AnyEvent::Log::ctx $_ } @_;
889 AnyEvent::Log::_reassess;
755} 890}
756 891
757sub detach { 892sub detach {
758 my $ctx = shift; 893 my $ctx = shift;
759 894
760 delete $ctx->[2]{$_+0} 895 delete $ctx->[2]{$_+0}
761 for map { AnyEvent::Log::ctx $_ } @_; 896 for map { AnyEvent::Log::ctx $_ } @_;
897 AnyEvent::Log::_reassess;
762} 898}
763 899
764sub slaves { 900sub slaves {
765 undef $_[0][2]; 901 undef $_[0][2];
766 &attach; 902 &attach;
903 AnyEvent::Log::_reassess;
767} 904}
768 905
769=back 906=back
770 907
771=head3 LOG TARGETS 908=head3 LOG TARGETS
… …
774the logging (which consists of formatting the message and printing it or 911the logging (which consists of formatting the message and printing it or
775whatever it wants to do with it). 912whatever it wants to do with it).
776 913
777=over 4 914=over 4
778 915
779=item $ctx->log_cb ($cb->($str) 916=item $ctx->log_cb ($cb->($str))
780 917
781Replaces the logging callback on the context (C<undef> disables the 918Replaces the logging callback on the context (C<undef> disables the
782logging callback). 919logging callback).
783 920
784The logging callback is responsible for handling formatted log messages 921The logging callback is responsible for handling formatted log messages
… …
809 946
810Replaces the formatting callback on the context (C<undef> restores the 947Replaces the formatting callback on the context (C<undef> restores the
811default formatter). 948default formatter).
812 949
813The callback is passed the (possibly fractional) timestamp, the original 950The callback is passed the (possibly fractional) timestamp, the original
814logging context, the (numeric) logging level and the raw message string 951logging context (object, not title), the (numeric) logging level and
815and needs to return a formatted log message. In most cases this will be a 952the raw message string and needs to return a formatted log message. In
816string, but it could just as well be an array reference that just stores 953most cases this will be a string, but it could just as well be an array
817the values. 954reference that just stores the values.
818 955
819If, for some reason, you want to use C<caller> to find out more baout the 956If, for some reason, you want to use C<caller> to find out more about the
820logger then you should walk up the call stack until you are no longer 957logger then you should walk up the call stack until you are no longer
821inside the C<AnyEvent::Log> package. 958inside the C<AnyEvent::Log> package.
822 959
960To implement your own logging callback, you might find the
961C<AnyEvent::Log::format_time> and C<AnyEvent::Log::default_format>
962functions useful.
963
964Example: format the message just as AnyEvent::Log would, by letting
965AnyEvent::Log do the work. This is a good basis to design a formatting
966callback that only changes minor aspects of the formatting.
967
968 $ctx->fmt_cb (sub {
969 my ($time, $ctx, $lvl, $msg) = @_;
970
971 AnyEvent::Log::default_format $time, $ctx, $lvl, $msg
972 });
973
823Example: format just the raw message, with numeric log level in angle 974Example: format just the raw message, with numeric log level in angle
824brackets. 975brackets.
825 976
826 $ctx->fmt_cb (sub { 977 $ctx->fmt_cb (sub {
827 my ($time, $ctx, $lvl, $msg) = @_; 978 my ($time, $ctx, $lvl, $msg) = @_;
828 979
829 "<$lvl>$msg\n" 980 "<$lvl>$msg\n"
830 }); 981 });
831 982
832Example: return an array reference with just the log values, and use 983Example: return an array reference with just the log values, and use
833C<PApp::SQL::sql_exec> to store the emssage in a database. 984C<PApp::SQL::sql_exec> to store the message in a database.
834 985
835 $ctx->fmt_cb (sub { \@_ }); 986 $ctx->fmt_cb (sub { \@_ });
836 $ctx->log_cb (sub { 987 $ctx->log_cb (sub {
837 my ($msg) = @_; 988 my ($msg) = @_;
838 989
… …
850Sets the C<log_cb> to simply use C<CORE::warn> to report any messages 1001Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
851(usually this logs to STDERR). 1002(usually this logs to STDERR).
852 1003
853=item $ctx->log_to_file ($path) 1004=item $ctx->log_to_file ($path)
854 1005
855Sets the C<log_cb> to log to a file (by appending), unbuffered. 1006Sets the C<log_cb> to log to a file (by appending), unbuffered. The
1007function might return before the log file has been opened or created.
856 1008
857=item $ctx->log_to_path ($path) 1009=item $ctx->log_to_path ($path)
858 1010
859Same as C<< ->log_to_file >>, but opens the file for each message. This 1011Same as C<< ->log_to_file >>, but opens the file for each message. This
860is much slower, but allows you to change/move/rename/delete the file at 1012is much slower, but allows you to change/move/rename/delete the file at
… …
862 1014
863Needless(?) to say, if you do not want to be bitten by some evil person 1015Needless(?) to say, if you do not want to be bitten by some evil person
864calling C<chdir>, the path should be absolute. Doesn't help with 1016calling C<chdir>, the path should be absolute. Doesn't help with
865C<chroot>, but hey... 1017C<chroot>, but hey...
866 1018
867=item $ctx->log_to_syslog ([$log_flags]) 1019=item $ctx->log_to_syslog ([$facility])
868 1020
869Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all 1021Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
870the others in the obvious way. If specified, then the C<$log_flags> are 1022all the others in the obvious way. If specified, then the C<$facility> is
871simply or'ed onto the priority argument and can contain any C<LOG_xxx> 1023used as the facility (C<user>, C<auth>, C<local0> and so on). The default
872flags valid for Sys::Syslog::syslog, except for the priority levels. 1024facility is C<user>.
873 1025
874Note that this function also sets a C<fmt_cb> - the logging part requires 1026Note that this function also sets a C<fmt_cb> - the logging part requires
875an array reference with [$level, $str] as input. 1027an array reference with [$level, $str] as input.
876 1028
877=cut 1029=cut
… …
895 warn shift; 1047 warn shift;
896 0 1048 0
897 }); 1049 });
898} 1050}
899 1051
1052# this function is a good example of why threads are a must,
1053# simply for priority inversion.
1054sub _log_to_disk {
1055 # eval'uating this at runtime saves 220kb rss - perl has become
1056 # an insane memory waster.
1057 eval q{ # poor man's autoloading {}
1058 sub _log_to_disk {
1059 my ($ctx, $path, $keepopen) = @_;
1060
1061 my $fh;
1062 my @queue;
1063 my $delay;
1064 my $disable;
1065
1066 use AnyEvent::IO ();
1067
1068 my $kick = sub {
1069 undef $delay;
1070 return unless @queue;
1071 $delay = 1;
1072
1073 # we pass $kick to $kick, so $kick itself doesn't keep a reference to $kick.
1074 my $kick = shift;
1075
1076 # write one or more messages
1077 my $write = sub {
1078 # we write as many messages as have been queued
1079 my $data = join "", @queue;
1080 @queue = ();
1081
1082 AnyEvent::IO::aio_write $fh, $data, sub {
1083 $disable = 1;
1084 @_
1085 ? ($_[0] == length $data or AE::log 4 => "unable to write to logfile '$path': short write")
1086 : AE::log 4 => "unable to write to logfile '$path': $!";
1087 undef $disable;
1088
1089 if ($keepopen) {
1090 $kick->($kick);
1091 } else {
1092 AnyEvent::IO::aio_close ($fh, sub {
1093 undef $fh;
1094 $kick->($kick);
1095 });
1096 }
1097 };
1098 };
1099
1100 if ($fh) {
1101 $write->();
1102 } else {
1103 AnyEvent::IO::aio_open
1104 $path,
1105 AnyEvent::IO::O_CREAT | AnyEvent::IO::O_WRONLY | AnyEvent::IO::O_APPEND,
1106 0666,
1107 sub {
1108 $fh = shift
1109 or do {
1110 $disable = 1;
1111 AE::log 4 => "unable to open logfile '$path': $!";
1112 undef $disable;
1113 return;
1114 };
1115
1116 $write->();
1117 }
1118 ;
1119 }
1120 };
1121
1122 $ctx->log_cb (sub {
1123 return if $disable;
1124 push @queue, shift;
1125 $kick->($kick) unless $delay;
1126 0
1127 });
1128
1129 $kick->($kick) if $keepopen; # initial open
1130 };
1131 };
1132 die if $@;
1133 &_log_to_disk
1134}
1135
900sub log_to_file { 1136sub log_to_file {
901 my ($ctx, $path) = @_; 1137 my ($ctx, $path) = @_;
902 1138
903 open my $fh, ">>", $path 1139 _log_to_disk $ctx, $path, 1;
904 or die "$path: $!";
905
906 $ctx->log_cb (sub {
907 syswrite $fh, shift;
908 0
909 });
910} 1140}
911 1141
912sub log_to_path { 1142sub log_to_path {
913 my ($ctx, $path) = @_; 1143 my ($ctx, $path) = @_;
914 1144
915 $ctx->log_cb (sub { 1145 _log_to_disk $ctx, $path, 0;
916 open my $fh, ">>", $path
917 or die "$path: $!";
918
919 syswrite $fh, shift;
920 0
921 });
922} 1146}
923 1147
924sub log_to_syslog { 1148sub log_to_syslog {
925 my ($ctx, $flags) = @_; 1149 my ($ctx, $facility) = @_;
926 1150
927 require Sys::Syslog; 1151 require Sys::Syslog;
928 1152
929 $ctx->fmt_cb (sub { 1153 $ctx->fmt_cb (sub {
930 my $str = $_[3]; 1154 my $str = $_[3];
931 $str =~ s/\n(?=.)/\n+ /g; 1155 $str =~ s/\n(?=.)/\n+ /g;
932 1156
933 [$_[2], "($_[1][0]) $str"] 1157 [$_[2], "($_[1][0]) $str"]
934 }); 1158 });
935 1159
1160 $facility ||= "user";
1161
936 $ctx->log_cb (sub { 1162 $ctx->log_cb (sub {
937 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8; 1163 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
938 1164
939 Sys::Syslog::syslog ($flags | ($lvl - 1), $_) 1165 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
940 for split /\n/, $_[0][1]; 1166 for split /\n/, $_[0][1];
941 1167
942 0 1168 0
943 }); 1169 });
944} 1170}
… …
953=over 4 1179=over 4
954 1180
955=item $ctx->log ($level, $msg[, @params]) 1181=item $ctx->log ($level, $msg[, @params])
956 1182
957Same as C<AnyEvent::Log::log>, but uses the given context as log context. 1183Same as C<AnyEvent::Log::log>, but uses the given context as log context.
1184
1185Example: log a message in the context of another package.
1186
1187 (AnyEvent::Log::ctx "Other::Package")->log (warn => "heely bo");
958 1188
959=item $logger = $ctx->logger ($level[, \$enabled]) 1189=item $logger = $ctx->logger ($level[, \$enabled])
960 1190
961Same as C<AnyEvent::Log::logger>, but uses the given context as log 1191Same as C<AnyEvent::Log::logger>, but uses the given context as log
962context. 1192context.
… …
1010 1240
1011Context names starting with a C<%> are anonymous contexts created when the 1241Context names starting with a C<%> are anonymous contexts created when the
1012name is first mentioned. The difference to package contexts is that by 1242name is first mentioned. The difference to package contexts is that by
1013default they have no attached slaves. 1243default they have no attached slaves.
1014 1244
1245This makes it possible to create new log contexts that can be refered to
1246multiple times by name within the same log specification.
1247
1015=item a perl package name 1248=item a perl package name
1016 1249
1017Any other string references the logging context associated with the given 1250Any other string references the logging context associated with the given
1018Perl C<package>. In the unlikely case where you want to specify a package 1251Perl C<package>. In the unlikely case where you want to specify a package
1019context that matches on of the other context name forms, you can add a 1252context that matches on of the other context name forms, you can add a
… …
1050=item C<nolog> 1283=item C<nolog>
1051 1284
1052Configures the context to not log anything by itself, which is the 1285Configures the context to not log anything by itself, which is the
1053default. Same as C<< $ctx->log_cb (undef) >>. 1286default. Same as C<< $ctx->log_cb (undef) >>.
1054 1287
1288=item C<cap=>I<level>
1289
1290Caps logging messages entering this context at the given level, i.e.
1291reduces the priority of messages with higher priority than this level. The
1292default is C<0> (or C<off>), meaning the priority will not be touched.
1293
1055=item C<0> or C<off> 1294=item C<0> or C<off>
1056 1295
1057Sets the logging level of the context ot C<0>, i.e. all messages will be 1296Sets the logging level of the context to C<0>, i.e. all messages will be
1058filtered out. 1297filtered out.
1059 1298
1060=item C<all> 1299=item C<all>
1061 1300
1062Enables all logging levels, i.e. filtering will effectively be switched 1301Enables all logging levels, i.e. filtering will effectively be switched
… …
1104 1343
1105Attaches the named context as slave to the context. 1344Attaches the named context as slave to the context.
1106 1345
1107=item C<+> 1346=item C<+>
1108 1347
1109A line C<+> detaches all contexts, i.e. clears the slave list from the 1348A lone C<+> detaches all contexts, i.e. clears the slave list from the
1110context. Anonymous (C<%name>) contexts have no attached slaves by default, 1349context. Anonymous (C<%name>) contexts have no attached slaves by default,
1111but package contexts have the parent context as slave by default. 1350but package contexts have the parent context as slave by default.
1112 1351
1113Example: log messages from My::Module to a file, do not send them to the 1352Example: log messages from My::Module to a file, do not send them to the
1114default log collector. 1353default log collector.
… …
1145 1384
1146 my $pkg = sub { 1385 my $pkg = sub {
1147 $_[0] eq "log" ? $LOG 1386 $_[0] eq "log" ? $LOG
1148 : $_[0] eq "filter" ? $FILTER 1387 : $_[0] eq "filter" ? $FILTER
1149 : $_[0] eq "collect" ? $COLLECT 1388 : $_[0] eq "collect" ? $COLLECT
1150 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef) 1389 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1151 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/ 1390 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1152 : die # never reached? 1391 : die # never reached?
1153 }; 1392 };
1154 1393
1155 /\G[[:space:]]+/gc; # skip initial whitespace 1394 /\G[[:space:]]+/gc; # skip initial whitespace
… …
1161 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) { 1400 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1162 for ("$1") { 1401 for ("$1") {
1163 if ($_ eq "stderr" ) { $ctx->log_to_warn; 1402 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1164 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1"); 1403 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1165 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1"); 1404 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1166 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog (eval "package Sys::Syslog; $1"); 1405 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1167 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef); 1406 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1407 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1168 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1")); 1408 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1169 } elsif ($_ eq "+" ) { $ctx->slaves; 1409 } elsif ($_ eq "+" ) { $ctx->slaves;
1170 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0); 1410 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1171 } elsif ($_ eq "all" ) { $ctx->level ("all"); 1411 } elsif ($_ eq "all" ) { $ctx->level ("all");
1172 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level"; 1412 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
… …
1189 if (/\G(.+)/g) { 1429 if (/\G(.+)/g) {
1190 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n"; 1430 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1191 } 1431 }
1192} 1432}
1193 1433
11941;
1195
1196=head1 EXAMPLES 1434=head1 EXAMPLES
1197 1435
1198This section shows some common configurations, both as code, and as 1436This section shows some common configurations, both as code, and as
1199C<PERL_ANYEVENT_LOG> string. 1437C<PERL_ANYEVENT_LOG> string.
1200 1438
… …
1224 1462
1225This writes them only when the global logging level allows it, because 1463This writes them only when the global logging level allows it, because
1226it is attached to the default context which is invoked I<after> global 1464it is attached to the default context which is invoked I<after> global
1227filtering. 1465filtering.
1228 1466
1229 $AnyEvent::Log::FILTER->attach 1467 $AnyEvent::Log::FILTER->attach (
1230 new AnyEvent::Log::Ctx log_to_file => $path); 1468 new AnyEvent::Log::Ctx log_to_file => $path);
1231 1469
1232 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path 1470 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
1233 1471
1234This writes them regardless of the global logging level, because it is 1472This writes them regardless of the global logging level, because it is
… …
1240 1478
1241 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger 1479 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1242 1480
1243In both cases, messages are still written to STDERR. 1481In both cases, messages are still written to STDERR.
1244 1482
1483=item Additionally log all messages with C<warn> and higher priority to
1484C<syslog>, but cap at C<error>.
1485
1486This logs all messages to the default log target, but also logs messages
1487with priority C<warn> or higher (and not filtered otherwise) to syslog
1488facility C<user>. Messages with priority higher than C<error> will be
1489logged with level C<error>.
1490
1491 $AnyEvent::Log::LOG->attach (
1492 new AnyEvent::Log::Ctx
1493 level => "warn",
1494 cap => "error",
1495 syslog => "user",
1496 );
1497
1498 PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog
1499
1245=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). 1500=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
1246 1501
1247Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1502Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
1248context - this simply circumvents the global filtering for trace messages. 1503context - this simply circumvents the global filtering for trace messages.
1249 1504
… …
1256assumes the log level for AnyEvent::Debug hasn't been changed from the 1511assumes the log level for AnyEvent::Debug hasn't been changed from the
1257default. 1512default.
1258 1513
1259=back 1514=back
1260 1515
1516=head1 ASYNCHRONOUS DISK I/O
1517
1518This module uses L<AnyEvent::IO> to actually write log messages (in
1519C<log_to_file> and C<log_to_path>), so it doesn't block your program when
1520the disk is busy and a non-blocking L<AnyEvent::IO> backend is available.
1521
1261=head1 AUTHOR 1522=head1 AUTHOR
1262 1523
1263 Marc Lehmann <schmorp@schmorp.de> 1524 Marc Lehmann <schmorp@schmorp.de>
1264 http://home.schmorp.de/ 1525 http://anyevent.schmorp.de
1265 1526
1266=cut 1527=cut
1267 1528
15291
1530

Diff Legend

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