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.40 by root, Fri Aug 26 16:18:01 2011 UTC vs.
Revision 1.66 by root, Mon Mar 11 20:48:19 2019 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 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
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):
43attempt to be "the" logging solution or even "a" logging solution for 61attempt to be "the" logging solution or even "a" logging solution for
44AnyEvent - AnyEvent simply creates logging messages internally, and this 62AnyEvent - AnyEvent simply creates logging messages internally, and this
45module 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
46using it from other modules as well. 64using it from other modules as well.
47 65
48Remember 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
49will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number 67errors and more important messages will be logged, unless you set
50before starting your program, or change the logging level at runtime with 68C<PERL_ANYEVENT_VERBOSE> to a higher number before starting your program
51something like: 69(C<AE_VERBOSE=5> is recommended during development), or change the logging
70level at runtime with something like:
52 71
53 use AnyEvent::Log; 72 use AnyEvent::Log;
54 $AnyEvent::Log::FILTER->level ("info"); 73 $AnyEvent::Log::FILTER->level ("info");
55 74
56The 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),
57but make it powerful enough to be potentially useful for any module, and 76but make it powerful enough to be potentially useful for any module,
58extensive enough for the most common tasks, such as logging to multiple 77and extensive enough for the most common tasks, such as logging to
59targets, or being able to log into a database. 78multiple targets, or being able to log into a database.
60 79
61The module is also usable before AnyEvent itself is initialised, in which 80The module is also usable before AnyEvent itself is initialised, in which
62case some of the functionality might be reduced. 81case some of the functionality might be reduced.
63 82
64The amount of documentation might indicate otherwise, but the runtime part 83The amount of documentation might indicate otherwise, but the runtime part
72numerical value". 91numerical value".
73 92
74Instead 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:
75 94
76 LVL NAME SYSLOG PERL NOTE 95 LVL NAME SYSLOG PERL NOTE
77 1 fatal emerg exit aborts program! 96 1 fatal emerg exit system unusable, aborts program!
78 2 alert 97 2 alert failure in primary system
79 3 critical crit 98 3 critical crit failure in backup system
80 4 error err die 99 4 error err die non-urgent program errors, a bug
81 5 warn warning 100 5 warn warning possible problem, not necessarily error
82 6 note notice 101 6 note notice unusual conditions
83 7 info 102 7 info normal messages, no action required
84 8 debug 103 8 debug debugging messages for development
85 9 trace 104 9 trace copious tracing output
86 105
87As 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
88is 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)
89and 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>
90at C<error> priority. 109messages at C<error> priority. The NOTE column tries to provide some
110rationale on how to chose a logging level.
91 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
92You 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>,
93(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
94program - 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.
95 124
96Some 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>
97or 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.
98 127
99=head1 LOGGING FUNCTIONS 128=head1 LOGGING FUNCTIONS
100 129
101These functions allow you to log messages. They always use the caller's 130The following functions allow you to log messages. They always use the
102package as a "logging context". Also, the main logging function C<log> is 131caller'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 132C<log>, is aliased to C<AnyEvent::log> and C<AE::log> when the C<AnyEvent>
104loaded. 133module is loaded.
105 134
106=over 4 135=over 4
107 136
108=cut 137=cut
109 138
110package AnyEvent::Log; 139package AnyEvent::Log;
111 140
112use Carp (); 141use Carp ();
113use POSIX (); 142use POSIX ();
114 143
144# layout of a context
145# 0 1 2 3 4, 5
146# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
147
115use AnyEvent (); BEGIN { AnyEvent::common_sense } 148use AnyEvent (); BEGIN { AnyEvent::common_sense }
116#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log 149#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
117 150
118our $VERSION = $AnyEvent::VERSION; 151our $VERSION = $AnyEvent::VERSION;
119 152
120our ($COLLECT, $FILTER, $LOG); 153our ($COLLECT, $FILTER, $LOG);
121 154
122our ($now_int, $now_str1, $now_str2); 155our ($now_int, $now_str1, $now_str2);
123 156
124# Format Time, not public - yet? 157# Format Time, not public - yet?
125sub ft($) { 158sub format_time($) {
126 my $i = int $_[0]; 159 my $i = int $_[0];
127 my $f = sprintf "%06d", 1e6 * ($_[0] - $i); 160 my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
128 161
129 ($now_int, $now_str1, $now_str2) = ($i, split /\x01/, POSIX::strftime "%Y-%m-%d %H:%M:%S.\x01 %z", localtime $i) 162 ($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; 163 if $now_int != $i;
151=item AnyEvent::Log::log $level, $msg[, @args] 184=item AnyEvent::Log::log $level, $msg[, @args]
152 185
153Requests 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
154returns true if the message was logged I<somewhere>. 187returns true if the message was logged I<somewhere>.
155 188
156For C<fatal> log levels, the program will abort. 189For loglevel C<fatal>, the program will abort.
157 190
158If 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
159C<$msg> is interpreted as an sprintf format string. 192C<$msg> is interpreted as an sprintf format string.
160 193
161The 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
163 196
164Last 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
165supposed 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
166actually 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
167message 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.
168 204
169Whether 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
170and 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
171messages or not "lost" - for example, when L<AnyEvent::Debug> detects a 207messages 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 208runtime error it tries to log it at C<die> level, but if that message is
226}; 262};
227 263
228our @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);
229 265
230# time, ctx, level, msg 266# time, ctx, level, msg
231sub _format($$$$) { 267sub default_format($$$$) {
232 my $ts = ft $_[0]; 268 my $ts = format_time $_[0];
233 my $ct = " "; 269 my $ct = " ";
234 270
235 my @res; 271 my @res;
236 272
237 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) { 273 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
240 } 276 }
241 277
242 join "", @res 278 join "", @res
243} 279}
244 280
281sub fatal_exit() {
282 exit 1;
283}
284
245sub _log { 285sub _log {
246 my ($ctx, $level, $format, @args) = @_; 286 my ($ctx, $level, $format, @args) = @_;
247 287
248 $level = $level > 0 && $level <= 9 288 $level = $level > 0 && $level <= 9
249 ? $level+0 289 ? $level+0
250 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 290 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
251 291
252 my $mask = 1 << $level; 292 my $mask = 1 << $level;
253 293
254 my ($success, %seen, @ctx, $now, $fmt); 294 my ($success, %seen, @ctx, $now, @fmt);
255 295
256 do 296 do
257 { 297 {
258 # skip if masked 298 # if !ref, then it's a level number
299 if (!ref $ctx) {
300 $level = $ctx;
259 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
260 if ($ctx->[3]) { 311 if ($ctx->[3]) {
261 # logging target found 312 # logging target found
313
314 local ($!, $@);
262 315
263 # now get raw message, unless we have it already 316 # now get raw message, unless we have it already
264 unless ($now) { 317 unless ($now) {
265 $format = $format->() if ref $format; 318 $format = $format->() if ref $format;
266 $format = sprintf $format, @args if @args; 319 $format = sprintf $format, @args if @args;
269 }; 322 };
270 323
271 # format msg 324 # format msg
272 my $str = $ctx->[4] 325 my $str = $ctx->[4]
273 ? $ctx->[4]($now, $_[0], $level, $format) 326 ? $ctx->[4]($now, $_[0], $level, $format)
274 : ($fmt ||= _format $now, $_[0], $level, $format); 327 : ($fmt[$level] ||= default_format $now, $_[0], $level, $format);
275 328
276 $success = 1; 329 $success = 1;
277 330
278 $ctx->[3]($str) 331 $ctx->[3]($str)
279 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 332 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
282 } 335 }
283 } 336 }
284 } 337 }
285 while $ctx = pop @ctx; 338 while $ctx = pop @ctx;
286 339
287 exit 1 if $level <= 1; 340 fatal_exit if $level <= 1;
288 341
289 $success 342 $success
290} 343}
291 344
292sub log($$;@) { 345sub log($$;@) {
293 _log 346 _log
294 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 347 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
295 @_; 348 @_;
296} 349}
297 350
298*AnyEvent::log = *AE::log = \&log;
299
300=item $logger = AnyEvent::Log::logger $level[, \$enabled] 351=item $logger = AnyEvent::Log::logger $level[, \$enabled]
301 352
302Creates a code reference that, when called, acts as if the 353Creates a code reference that, when called, acts as if the
303C<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
304level. 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
368 419
369 $LOGGER{$logger+0} = $logger; 420 $LOGGER{$logger+0} = $logger;
370 421
371 _reassess $logger+0; 422 _reassess $logger+0;
372 423
373 require AnyEvent::Util; 424 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
374 my $guard = AnyEvent::Util::guard (sub { 425 my $guard = AnyEvent::Util::guard (sub {
375 # "clean up" 426 # "clean up"
376 delete $LOGGER{$logger+0}; 427 delete $LOGGER{$logger+0};
377 }); 428 });
378 429
402 453
403Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been 454Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
404initialised, this switch will also decide whether to use C<CORE::time> or 455initialised, this switch will also decide whether to use C<CORE::time> or
405C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes 456C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
406available. 457available.
458
459=item AnyEvent::Log::format_time $timestamp
460
461Formats a timestamp as returned by C<< AnyEvent->now >> or C<<
462AnyEvent->time >> or many other functions in the same way as
463C<AnyEvent::Log> does.
464
465In your main program (as opposed to in your module) you can override
466the default timestamp display format by loading this module and then
467redefining this function.
468
469Most commonly, this function can be used in formatting callbacks.
470
471=item AnyEvent::Log::default_format $time, $ctx, $level, $msg
472
473Format a log message using the given timestamp, logging context, log level
474and log message.
475
476This is the formatting function used to format messages when no custom
477function is provided.
478
479In your main program (as opposed to in your module) you can override the
480default message format by loading this module and then redefining this
481function.
482
483=item AnyEvent::Log::fatal_exit()
484
485This is the function that is called after logging a C<fatal> log
486message. It must not return.
487
488The default implementation simply calls C<exit 1>.
489
490In your main program (as opposed to in your module) you can override
491the fatal exit function by loading this module and then redefining this
492function. Make sure you don't return.
407 493
408=back 494=back
409 495
410=head1 LOGGING CONTEXTS 496=head1 LOGGING CONTEXTS
411 497
531This can be used to implement config-file (re-)loading: before loading a 617This can be used to implement config-file (re-)loading: before loading a
532configuration, reset all contexts. 618configuration, reset all contexts.
533 619
534=cut 620=cut
535 621
622our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
623$AnyEvent::VERBOSE = 9;
624
536sub reset { 625sub reset {
537 # hard to kill complex data structures 626 # hard to kill complex data structures
538 # we "recreate" all package loggers and reset the hierarchy 627 # we "recreate" all package loggers and reset the hierarchy
539 while (my ($k, $v) = each %CTX) { 628 while (my ($k, $v) = each %CTX) {
540 @$v = ($k, (1 << 10) - 1 - 1, { }); 629 @$v = ($k, (1 << 10) - 1 - 1, { });
549 $LOG->title ('$AnyEvent::Log::LOG'); 638 $LOG->title ('$AnyEvent::Log::LOG');
550 $LOG->log_to_warn; 639 $LOG->log_to_warn;
551 640
552 $FILTER->slaves ($LOG); 641 $FILTER->slaves ($LOG);
553 $FILTER->title ('$AnyEvent::Log::FILTER'); 642 $FILTER->title ('$AnyEvent::Log::FILTER');
554 $FILTER->level ($AnyEvent::VERBOSE); 643 $FILTER->level ($ORIG_VERBOSE);
555 644
556 $COLLECT->slaves ($FILTER); 645 $COLLECT->slaves ($FILTER);
557 $COLLECT->title ('$AnyEvent::Log::COLLECT'); 646 $COLLECT->title ('$AnyEvent::Log::COLLECT');
558 647
559 _reassess; 648 _reassess;
560} 649}
650
651# override AE::log/logger
652*AnyEvent::log = *AE::log = \&log;
653*AnyEvent::logger = *AE::logger = \&logger;
654
655# convert AnyEvent loggers to AnyEvent::Log loggers
656$_->[0] = ctx $_->[0] # convert "pkg" to "ctx"
657 for values %LOGGER;
561 658
562# create the default logger contexts 659# create the default logger contexts
563$LOG = ctx undef; 660$LOG = ctx undef;
564$FILTER = ctx undef; 661$FILTER = ctx undef;
565$COLLECT = ctx undef; 662$COLLECT = ctx undef;
574package AnyEvent::Log::COLLECT; 671package AnyEvent::Log::COLLECT;
575package AE::Log::COLLECT; 672package AE::Log::COLLECT;
576 673
577package AnyEvent::Log::Ctx; 674package AnyEvent::Log::Ctx;
578 675
579# 0 1 2 3 4
580# [$title, $level, %$slaves, &$logcb, &$fmtcb]
581
582=item $ctx = new AnyEvent::Log::Ctx methodname => param... 676=item $ctx = new AnyEvent::Log::Ctx methodname => param...
583 677
584This is a convenience constructor that makes it simpler to construct 678This is a convenience constructor that makes it simpler to construct
585anonymous logging contexts. 679anonymous logging contexts.
586 680
673 767
674=item $ctx->disable ($level[, $level...]) 768=item $ctx->disable ($level[, $level...])
675 769
676Disables logging for the given levels, leaving all others unchanged. 770Disables logging for the given levels, leaving all others unchanged.
677 771
772=item $ctx->cap ($level)
773
774Caps the maximum priority to the given level, for all messages logged
775to, or passing through, this context. That is, while this doesn't affect
776whether a message is logged or passed on, the maximum priority of messages
777will be limited to the specified level - messages with a higher priority
778will be set to the specified priority.
779
780Another way to view this is that C<< ->level >> filters out messages with
781a too low priority, while C<< ->cap >> modifies messages with a too high
782priority.
783
784This is useful when different log targets have different interpretations
785of priority. For example, for a specific command line program, a wrong
786command line switch might well result in a C<fatal> log message, while the
787same message, logged to syslog, is likely I<not> fatal to the system or
788syslog facility as a whole, but more likely a mere C<error>.
789
790This can be modeled by having a stderr logger that logs messages "as-is"
791and a syslog logger that logs messages with a level cap of, say, C<error>,
792or, for truly system-critical components, actually C<critical>.
793
678=cut 794=cut
679 795
680sub _lvl_lst { 796sub _lvl_lst {
681 map { 797 map {
682 $_ > 0 && $_ <= 9 ? $_+0 798 $_ > 0 && $_ <= 9 ? $_+0
683 : $_ eq "all" ? (1 .. 9) 799 : $_ eq "all" ? (1 .. 9)
684 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 800 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
685 } @_ 801 } @_
686} 802}
687 803
804sub _lvl {
805 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
806}
807
688our $NOP_CB = sub { 0 }; 808our $NOP_CB = sub { 0 };
689 809
690sub levels { 810sub levels {
691 my $ctx = shift; 811 my $ctx = shift;
692 $ctx->[1] = 0; 812 $ctx->[1] = 0;
695 AnyEvent::Log::_reassess; 815 AnyEvent::Log::_reassess;
696} 816}
697 817
698sub level { 818sub level {
699 my $ctx = shift; 819 my $ctx = shift;
700 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
701
702 $ctx->[1] = ((1 << $lvl) - 1) << 1; 820 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
703 AnyEvent::Log::_reassess; 821 AnyEvent::Log::_reassess;
704} 822}
705 823
706sub enable { 824sub enable {
707 my $ctx = shift; 825 my $ctx = shift;
715 $ctx->[1] &= ~(1 << $_) 833 $ctx->[1] &= ~(1 << $_)
716 for &_lvl_lst; 834 for &_lvl_lst;
717 AnyEvent::Log::_reassess; 835 AnyEvent::Log::_reassess;
718} 836}
719 837
838sub cap {
839 my $ctx = shift;
840 $ctx->[5] = &_lvl;
841}
842
720=back 843=back
721 844
722=head3 SLAVE CONTEXTS 845=head3 SLAVE CONTEXTS
723 846
724The following methods attach and detach another logging context to a 847The following methods attach and detach another logging context to a
776the logging (which consists of formatting the message and printing it or 899the logging (which consists of formatting the message and printing it or
777whatever it wants to do with it). 900whatever it wants to do with it).
778 901
779=over 4 902=over 4
780 903
781=item $ctx->log_cb ($cb->($str) 904=item $ctx->log_cb ($cb->($str))
782 905
783Replaces the logging callback on the context (C<undef> disables the 906Replaces the logging callback on the context (C<undef> disables the
784logging callback). 907logging callback).
785 908
786The logging callback is responsible for handling formatted log messages 909The logging callback is responsible for handling formatted log messages
811 934
812Replaces the formatting callback on the context (C<undef> restores the 935Replaces the formatting callback on the context (C<undef> restores the
813default formatter). 936default formatter).
814 937
815The callback is passed the (possibly fractional) timestamp, the original 938The callback is passed the (possibly fractional) timestamp, the original
816logging context, the (numeric) logging level and the raw message string 939logging context (object, not title), the (numeric) logging level and
817and needs to return a formatted log message. In most cases this will be a 940the raw message string and needs to return a formatted log message. In
818string, but it could just as well be an array reference that just stores 941most cases this will be a string, but it could just as well be an array
819the values. 942reference that just stores the values.
820 943
821If, for some reason, you want to use C<caller> to find out more baout the 944If, for some reason, you want to use C<caller> to find out more about the
822logger then you should walk up the call stack until you are no longer 945logger then you should walk up the call stack until you are no longer
823inside the C<AnyEvent::Log> package. 946inside the C<AnyEvent::Log> package.
824 947
948To implement your own logging callback, you might find the
949C<AnyEvent::Log::format_time> and C<AnyEvent::Log::default_format>
950functions useful.
951
952Example: format the message just as AnyEvent::Log would, by letting
953AnyEvent::Log do the work. This is a good basis to design a formatting
954callback that only changes minor aspects of the formatting.
955
956 $ctx->fmt_cb (sub {
957 my ($time, $ctx, $lvl, $msg) = @_;
958
959 AnyEvent::Log::default_format $time, $ctx, $lvl, $msg
960 });
961
825Example: format just the raw message, with numeric log level in angle 962Example: format just the raw message, with numeric log level in angle
826brackets. 963brackets.
827 964
828 $ctx->fmt_cb (sub { 965 $ctx->fmt_cb (sub {
829 my ($time, $ctx, $lvl, $msg) = @_; 966 my ($time, $ctx, $lvl, $msg) = @_;
830 967
831 "<$lvl>$msg\n" 968 "<$lvl>$msg\n"
832 }); 969 });
833 970
834Example: return an array reference with just the log values, and use 971Example: return an array reference with just the log values, and use
835C<PApp::SQL::sql_exec> to store the emssage in a database. 972C<PApp::SQL::sql_exec> to store the message in a database.
836 973
837 $ctx->fmt_cb (sub { \@_ }); 974 $ctx->fmt_cb (sub { \@_ });
838 $ctx->log_cb (sub { 975 $ctx->log_cb (sub {
839 my ($msg) = @_; 976 my ($msg) = @_;
840 977
852Sets the C<log_cb> to simply use C<CORE::warn> to report any messages 989Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
853(usually this logs to STDERR). 990(usually this logs to STDERR).
854 991
855=item $ctx->log_to_file ($path) 992=item $ctx->log_to_file ($path)
856 993
857Sets the C<log_cb> to log to a file (by appending), unbuffered. 994Sets the C<log_cb> to log to a file (by appending), unbuffered. The
995function might return before the log file has been opened or created.
858 996
859=item $ctx->log_to_path ($path) 997=item $ctx->log_to_path ($path)
860 998
861Same as C<< ->log_to_file >>, but opens the file for each message. This 999Same as C<< ->log_to_file >>, but opens the file for each message. This
862is much slower, but allows you to change/move/rename/delete the file at 1000is much slower, but allows you to change/move/rename/delete the file at
897 warn shift; 1035 warn shift;
898 0 1036 0
899 }); 1037 });
900} 1038}
901 1039
1040# this function is a good example of why threads are a must,
1041# simply for priority inversion.
1042sub _log_to_disk {
1043 # eval'uating this at runtime saves 220kb rss - perl has become
1044 # an insane memory waster.
1045 eval q{ # poor man's autoloading {}
1046 sub _log_to_disk {
1047 my ($ctx, $path, $keepopen) = @_;
1048
1049 my $fh;
1050 my @queue;
1051 my $delay;
1052 my $disable;
1053
1054 use AnyEvent::IO ();
1055
1056 my $kick = sub {
1057 undef $delay;
1058 return unless @queue;
1059 $delay = 1;
1060
1061 # we pass $kick to $kick, so $kick itself doesn't keep a reference to $kick.
1062 my $kick = shift;
1063
1064 # write one or more messages
1065 my $write = sub {
1066 # we write as many messages as have been queued
1067 my $data = join "", @queue;
1068 @queue = ();
1069
1070 AnyEvent::IO::aio_write $fh, $data, sub {
1071 $disable = 1;
1072 @_
1073 ? ($_[0] == length $data or AE::log 4 => "unable to write to logfile '$path': short write")
1074 : AE::log 4 => "unable to write to logfile '$path': $!";
1075 undef $disable;
1076
1077 if ($keepopen) {
1078 $kick->($kick);
1079 } else {
1080 AnyEvent::IO::aio_close ($fh, sub {
1081 undef $fh;
1082 $kick->($kick);
1083 });
1084 }
1085 };
1086 };
1087
1088 if ($fh) {
1089 $write->();
1090 } else {
1091 AnyEvent::IO::aio_open
1092 $path,
1093 AnyEvent::IO::O_CREAT | AnyEvent::IO::O_WRONLY | AnyEvent::IO::O_APPEND,
1094 0666,
1095 sub {
1096 $fh = shift
1097 or do {
1098 $disable = 1;
1099 AE::log 4 => "unable to open logfile '$path': $!";
1100 undef $disable;
1101 return;
1102 };
1103
1104 $write->();
1105 }
1106 ;
1107 }
1108 };
1109
1110 $ctx->log_cb (sub {
1111 return if $disable;
1112 push @queue, shift;
1113 $kick->($kick) unless $delay;
1114 0
1115 });
1116
1117 $kick->($kick) if $keepopen; # initial open
1118 };
1119 };
1120 die if $@;
1121 &_log_to_disk
1122}
1123
902sub log_to_file { 1124sub log_to_file {
903 my ($ctx, $path) = @_; 1125 my ($ctx, $path) = @_;
904 1126
905 open my $fh, ">>", $path 1127 _log_to_disk $ctx, $path, 1;
906 or die "$path: $!";
907
908 $ctx->log_cb (sub {
909 syswrite $fh, shift;
910 0
911 });
912} 1128}
913 1129
914sub log_to_path { 1130sub log_to_path {
915 my ($ctx, $path) = @_; 1131 my ($ctx, $path) = @_;
916 1132
917 $ctx->log_cb (sub { 1133 _log_to_disk $ctx, $path, 0;
918 open my $fh, ">>", $path
919 or die "$path: $!";
920
921 syswrite $fh, shift;
922 0
923 });
924} 1134}
925 1135
926sub log_to_syslog { 1136sub log_to_syslog {
927 my ($ctx, $facility) = @_; 1137 my ($ctx, $facility) = @_;
928 1138
957=over 4 1167=over 4
958 1168
959=item $ctx->log ($level, $msg[, @params]) 1169=item $ctx->log ($level, $msg[, @params])
960 1170
961Same as C<AnyEvent::Log::log>, but uses the given context as log context. 1171Same as C<AnyEvent::Log::log>, but uses the given context as log context.
1172
1173Example: log a message in the context of another package.
1174
1175 (AnyEvent::Log::ctx "Other::Package")->log (warn => "heely bo");
962 1176
963=item $logger = $ctx->logger ($level[, \$enabled]) 1177=item $logger = $ctx->logger ($level[, \$enabled])
964 1178
965Same as C<AnyEvent::Log::logger>, but uses the given context as log 1179Same as C<AnyEvent::Log::logger>, but uses the given context as log
966context. 1180context.
1014 1228
1015Context names starting with a C<%> are anonymous contexts created when the 1229Context names starting with a C<%> are anonymous contexts created when the
1016name is first mentioned. The difference to package contexts is that by 1230name is first mentioned. The difference to package contexts is that by
1017default they have no attached slaves. 1231default they have no attached slaves.
1018 1232
1233This makes it possible to create new log contexts that can be refered to
1234multiple times by name within the same log specification.
1235
1019=item a perl package name 1236=item a perl package name
1020 1237
1021Any other string references the logging context associated with the given 1238Any other string references the logging context associated with the given
1022Perl C<package>. In the unlikely case where you want to specify a package 1239Perl C<package>. In the unlikely case where you want to specify a package
1023context that matches on of the other context name forms, you can add a 1240context that matches on of the other context name forms, you can add a
1054=item C<nolog> 1271=item C<nolog>
1055 1272
1056Configures the context to not log anything by itself, which is the 1273Configures the context to not log anything by itself, which is the
1057default. Same as C<< $ctx->log_cb (undef) >>. 1274default. Same as C<< $ctx->log_cb (undef) >>.
1058 1275
1276=item C<cap=>I<level>
1277
1278Caps logging messages entering this context at the given level, i.e.
1279reduces the priority of messages with higher priority than this level. The
1280default is C<0> (or C<off>), meaning the priority will not be touched.
1281
1059=item C<0> or C<off> 1282=item C<0> or C<off>
1060 1283
1061Sets the logging level of the context ot C<0>, i.e. all messages will be 1284Sets the logging level of the context to C<0>, i.e. all messages will be
1062filtered out. 1285filtered out.
1063 1286
1064=item C<all> 1287=item C<all>
1065 1288
1066Enables all logging levels, i.e. filtering will effectively be switched 1289Enables all logging levels, i.e. filtering will effectively be switched
1108 1331
1109Attaches the named context as slave to the context. 1332Attaches the named context as slave to the context.
1110 1333
1111=item C<+> 1334=item C<+>
1112 1335
1113A line C<+> detaches all contexts, i.e. clears the slave list from the 1336A lone C<+> detaches all contexts, i.e. clears the slave list from the
1114context. Anonymous (C<%name>) contexts have no attached slaves by default, 1337context. Anonymous (C<%name>) contexts have no attached slaves by default,
1115but package contexts have the parent context as slave by default. 1338but package contexts have the parent context as slave by default.
1116 1339
1117Example: log messages from My::Module to a file, do not send them to the 1340Example: log messages from My::Module to a file, do not send them to the
1118default log collector. 1341default log collector.
1149 1372
1150 my $pkg = sub { 1373 my $pkg = sub {
1151 $_[0] eq "log" ? $LOG 1374 $_[0] eq "log" ? $LOG
1152 : $_[0] eq "filter" ? $FILTER 1375 : $_[0] eq "filter" ? $FILTER
1153 : $_[0] eq "collect" ? $COLLECT 1376 : $_[0] eq "collect" ? $COLLECT
1154 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef) 1377 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1155 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/ 1378 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1156 : die # never reached? 1379 : die # never reached?
1157 }; 1380 };
1158 1381
1159 /\G[[:space:]]+/gc; # skip initial whitespace 1382 /\G[[:space:]]+/gc; # skip initial whitespace
1165 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) { 1388 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1166 for ("$1") { 1389 for ("$1") {
1167 if ($_ eq "stderr" ) { $ctx->log_to_warn; 1390 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1168 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1"); 1391 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1169 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1"); 1392 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1170 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ($1); 1393 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1171 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef); 1394 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1395 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1172 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1")); 1396 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1173 } elsif ($_ eq "+" ) { $ctx->slaves; 1397 } elsif ($_ eq "+" ) { $ctx->slaves;
1174 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0); 1398 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1175 } elsif ($_ eq "all" ) { $ctx->level ("all"); 1399 } elsif ($_ eq "all" ) { $ctx->level ("all");
1176 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level"; 1400 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1193 if (/\G(.+)/g) { 1417 if (/\G(.+)/g) {
1194 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n"; 1418 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1195 } 1419 }
1196} 1420}
1197 1421
11981;
1199
1200=head1 EXAMPLES 1422=head1 EXAMPLES
1201 1423
1202This section shows some common configurations, both as code, and as 1424This section shows some common configurations, both as code, and as
1203C<PERL_ANYEVENT_LOG> string. 1425C<PERL_ANYEVENT_LOG> string.
1204 1426
1228 1450
1229This writes them only when the global logging level allows it, because 1451This writes them only when the global logging level allows it, because
1230it is attached to the default context which is invoked I<after> global 1452it is attached to the default context which is invoked I<after> global
1231filtering. 1453filtering.
1232 1454
1233 $AnyEvent::Log::FILTER->attach 1455 $AnyEvent::Log::FILTER->attach (
1234 new AnyEvent::Log::Ctx log_to_file => $path); 1456 new AnyEvent::Log::Ctx log_to_file => $path);
1235 1457
1236 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path 1458 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
1237 1459
1238This writes them regardless of the global logging level, because it is 1460This writes them regardless of the global logging level, because it is
1244 1466
1245 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger 1467 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1246 1468
1247In both cases, messages are still written to STDERR. 1469In both cases, messages are still written to STDERR.
1248 1470
1471=item Additionally log all messages with C<warn> and higher priority to
1472C<syslog>, but cap at C<error>.
1473
1474This logs all messages to the default log target, but also logs messages
1475with priority C<warn> or higher (and not filtered otherwise) to syslog
1476facility C<user>. Messages with priority higher than C<error> will be
1477logged with level C<error>.
1478
1479 $AnyEvent::Log::LOG->attach (
1480 new AnyEvent::Log::Ctx
1481 level => "warn",
1482 cap => "error",
1483 syslog => "user",
1484 );
1485
1486 PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog
1487
1249=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). 1488=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
1250 1489
1251Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1490Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
1252context - this simply circumvents the global filtering for trace messages. 1491context - this simply circumvents the global filtering for trace messages.
1253 1492
1260assumes the log level for AnyEvent::Debug hasn't been changed from the 1499assumes the log level for AnyEvent::Debug hasn't been changed from the
1261default. 1500default.
1262 1501
1263=back 1502=back
1264 1503
1504=head1 ASYNCHRONOUS DISK I/O
1505
1506This module uses L<AnyEvent::IO> to actually write log messages (in
1507C<log_to_file> and C<log_to_path>), so it doesn't block your program when
1508the disk is busy and a non-blocking L<AnyEvent::IO> backend is available.
1509
1265=head1 AUTHOR 1510=head1 AUTHOR
1266 1511
1267 Marc Lehmann <schmorp@schmorp.de> 1512 Marc Lehmann <schmorp@schmorp.de>
1268 http://home.schmorp.de/ 1513 http://anyevent.schmorp.de
1269 1514
1270=cut 1515=cut
1271 1516
15171
1518

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines