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.58 by root, Thu Apr 5 04:12:21 2012 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
… …
32 50
33 # send all critical and higher priority messages to syslog, 51 # send all critical and higher priority messages to syslog,
34 # regardless of (most) other settings 52 # regardless of (most) other settings
35 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx 53 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
36 level => "critical", 54 level => "critical",
37 log_to_syslog => 0, 55 log_to_syslog => "user",
38 ); 56 );
39 57
40=head1 DESCRIPTION 58=head1 DESCRIPTION
41 59
42This module implements a relatively simple "logging framework". It doesn't 60This module implements a relatively simple "logging framework". It doesn't
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),
… …
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 ();
143
144# layout of a context
145# 0 1 2 3 4, 5
146# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
114 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;
… …
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
… …
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] ||= _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
… …
395By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached 446By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
396eventloop time, for the log timestamps. After calling this function with a 447eventloop 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 448true 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 449time 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>). 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.
400 453
401Since 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
402initialised, 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
403C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes 456C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
404available. 457available.
… …
529This 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
530configuration, reset all contexts. 583configuration, reset all contexts.
531 584
532=cut 585=cut
533 586
587our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
588$AnyEvent::VERBOSE = 9;
589
534sub reset { 590sub reset {
535 # hard to kill complex data structures 591 # hard to kill complex data structures
536 # we "recreate" all package loggers and reset the hierarchy 592 # we "recreate" all package loggers and reset the hierarchy
537 while (my ($k, $v) = each %CTX) { 593 while (my ($k, $v) = each %CTX) {
538 @$v = ($k, (1 << 10) - 1 - 1, { }); 594 @$v = ($k, (1 << 10) - 1 - 1, { });
… …
547 $LOG->title ('$AnyEvent::Log::LOG'); 603 $LOG->title ('$AnyEvent::Log::LOG');
548 $LOG->log_to_warn; 604 $LOG->log_to_warn;
549 605
550 $FILTER->slaves ($LOG); 606 $FILTER->slaves ($LOG);
551 $FILTER->title ('$AnyEvent::Log::FILTER'); 607 $FILTER->title ('$AnyEvent::Log::FILTER');
552 $FILTER->level ($AnyEvent::VERBOSE); 608 $FILTER->level ($ORIG_VERBOSE);
553 609
554 $COLLECT->slaves ($FILTER); 610 $COLLECT->slaves ($FILTER);
555 $COLLECT->title ('$AnyEvent::Log::COLLECT'); 611 $COLLECT->title ('$AnyEvent::Log::COLLECT');
556 612
557 _reassess; 613 _reassess;
558} 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;
559 623
560# create the default logger contexts 624# create the default logger contexts
561$LOG = ctx undef; 625$LOG = ctx undef;
562$FILTER = ctx undef; 626$FILTER = ctx undef;
563$COLLECT = ctx undef; 627$COLLECT = ctx undef;
… …
572package AnyEvent::Log::COLLECT; 636package AnyEvent::Log::COLLECT;
573package AE::Log::COLLECT; 637package AE::Log::COLLECT;
574 638
575package AnyEvent::Log::Ctx; 639package AnyEvent::Log::Ctx;
576 640
577# 0 1 2 3 4
578# [$title, $level, %$slaves, &$logcb, &$fmtcb]
579
580=item $ctx = new AnyEvent::Log::Ctx methodname => param... 641=item $ctx = new AnyEvent::Log::Ctx methodname => param...
581 642
582This is a convenience constructor that makes it simpler to construct 643This is a convenience constructor that makes it simpler to construct
583anonymous logging contexts. 644anonymous logging contexts.
584 645
… …
671 732
672=item $ctx->disable ($level[, $level...]) 733=item $ctx->disable ($level[, $level...])
673 734
674Disables logging for the given levels, leaving all others unchanged. 735Disables logging for the given levels, leaving all others unchanged.
675 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
676=cut 759=cut
677 760
678sub _lvl_lst { 761sub _lvl_lst {
679 map { 762 map {
680 $_ > 0 && $_ <= 9 ? $_+0 763 $_ > 0 && $_ <= 9 ? $_+0
681 : $_ eq "all" ? (1 .. 9) 764 : $_ eq "all" ? (1 .. 9)
682 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 765 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
683 } @_ 766 } @_
684} 767}
685 768
769sub _lvl {
770 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
771}
772
686our $NOP_CB = sub { 0 }; 773our $NOP_CB = sub { 0 };
687 774
688sub levels { 775sub levels {
689 my $ctx = shift; 776 my $ctx = shift;
690 $ctx->[1] = 0; 777 $ctx->[1] = 0;
… …
693 AnyEvent::Log::_reassess; 780 AnyEvent::Log::_reassess;
694} 781}
695 782
696sub level { 783sub level {
697 my $ctx = shift; 784 my $ctx = shift;
698 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
699
700 $ctx->[1] = ((1 << $lvl) - 1) << 1; 785 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
701 AnyEvent::Log::_reassess; 786 AnyEvent::Log::_reassess;
702} 787}
703 788
704sub enable { 789sub enable {
705 my $ctx = shift; 790 my $ctx = shift;
… …
713 $ctx->[1] &= ~(1 << $_) 798 $ctx->[1] &= ~(1 << $_)
714 for &_lvl_lst; 799 for &_lvl_lst;
715 AnyEvent::Log::_reassess; 800 AnyEvent::Log::_reassess;
716} 801}
717 802
803sub cap {
804 my $ctx = shift;
805 $ctx->[5] = &_lvl;
806}
807
718=back 808=back
719 809
720=head3 SLAVE CONTEXTS 810=head3 SLAVE CONTEXTS
721 811
722The following methods attach and detach another logging context to a 812The following methods attach and detach another logging context to a
… …
774the logging (which consists of formatting the message and printing it or 864the logging (which consists of formatting the message and printing it or
775whatever it wants to do with it). 865whatever it wants to do with it).
776 866
777=over 4 867=over 4
778 868
779=item $ctx->log_cb ($cb->($str) 869=item $ctx->log_cb ($cb->($str))
780 870
781Replaces the logging callback on the context (C<undef> disables the 871Replaces the logging callback on the context (C<undef> disables the
782logging callback). 872logging callback).
783 873
784The logging callback is responsible for handling formatted log messages 874The logging callback is responsible for handling formatted log messages
… …
809 899
810Replaces the formatting callback on the context (C<undef> restores the 900Replaces the formatting callback on the context (C<undef> restores the
811default formatter). 901default formatter).
812 902
813The callback is passed the (possibly fractional) timestamp, the original 903The callback is passed the (possibly fractional) timestamp, the original
814logging context, the (numeric) logging level and the raw message string 904logging context (object, not title), the (numeric) logging level and
815and 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
816string, 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
817the values. 907reference that just stores the values.
818 908
819If, for some reason, 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
820logger 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
821inside the C<AnyEvent::Log> package. 911inside the C<AnyEvent::Log> package.
822 912
823Example: format just the raw message, with numeric log level in angle 913Example: format just the raw message, with numeric log level in angle
824brackets. 914brackets.
… …
828 918
829 "<$lvl>$msg\n" 919 "<$lvl>$msg\n"
830 }); 920 });
831 921
832Example: return an array reference with just the log values, and use 922Example: return an array reference with just the log values, and use
833C<PApp::SQL::sql_exec> to store the emssage in a database. 923C<PApp::SQL::sql_exec> to store the message in a database.
834 924
835 $ctx->fmt_cb (sub { \@_ }); 925 $ctx->fmt_cb (sub { \@_ });
836 $ctx->log_cb (sub { 926 $ctx->log_cb (sub {
837 my ($msg) = @_; 927 my ($msg) = @_;
838 928
… …
850Sets the C<log_cb> to simply use C<CORE::warn> to report any messages 940Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
851(usually this logs to STDERR). 941(usually this logs to STDERR).
852 942
853=item $ctx->log_to_file ($path) 943=item $ctx->log_to_file ($path)
854 944
855Sets the C<log_cb> to log to a file (by appending), unbuffered. 945Sets the C<log_cb> to log to a file (by appending), unbuffered. The
946function might return before the log file has been opened or created.
856 947
857=item $ctx->log_to_path ($path) 948=item $ctx->log_to_path ($path)
858 949
859Same as C<< ->log_to_file >>, but opens the file for each message. This 950Same 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 951is much slower, but allows you to change/move/rename/delete the file at
… …
862 953
863Needless(?) to say, if you do not want to be bitten by some evil person 954Needless(?) 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 955calling C<chdir>, the path should be absolute. Doesn't help with
865C<chroot>, but hey... 956C<chroot>, but hey...
866 957
867=item $ctx->log_to_syslog ([$log_flags]) 958=item $ctx->log_to_syslog ([$facility])
868 959
869Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all 960Logs 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 961all 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> 962used 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. 963facility is C<user>.
873 964
874Note that this function also sets a C<fmt_cb> - the logging part requires 965Note that this function also sets a C<fmt_cb> - the logging part requires
875an array reference with [$level, $str] as input. 966an array reference with [$level, $str] as input.
876 967
877=cut 968=cut
… …
895 warn shift; 986 warn shift;
896 0 987 0
897 }); 988 });
898} 989}
899 990
991# this function is a good example of why threads are a must,
992# simply for priority inversion.
993sub _log_to_disk {
994 # eval'uating this at runtime saves 220kb rss - perl has become
995 # an insane memory waster.
996 eval q{ # poor man's autoloading {}
997 sub _log_to_disk {
998 my ($ctx, $path, $keepopen) = @_;
999
1000 my $fh;
1001 my @queue;
1002 my $delay;
1003 my $disable;
1004
1005 use AnyEvent::IO ();
1006
1007 my $kick = sub {
1008 undef $delay;
1009 return unless @queue;
1010 $delay = 1;
1011
1012 # we pass $kick to $kick, so $kick itself doesn't keep a reference to $kick.
1013 my $kick = shift;
1014
1015 # write one or more messages
1016 my $write = sub {
1017 # we write as many messages as have been queued
1018 my $data = join "", @queue;
1019 @queue = ();
1020
1021 AnyEvent::IO::aio_write $fh, $data, sub {
1022 $disable = 1;
1023 @_
1024 ? ($_[0] == length $data or AE::log 4 => "unable to write to logfile '$path': short write")
1025 : AE::log 4 => "unable to write to logfile '$path': $!";
1026 undef $disable;
1027
1028 if ($keepopen) {
1029 $kick->($kick);
1030 } else {
1031 AnyEvent::IO::aio_close ($fh, sub {
1032 undef $fh;
1033 $kick->($kick);
1034 });
1035 }
1036 };
1037 };
1038
1039 if ($fh) {
1040 $write->();
1041 } else {
1042 AnyEvent::IO::aio_open
1043 $path,
1044 AnyEvent::IO::O_CREAT | AnyEvent::IO::O_WRONLY | AnyEvent::IO::O_APPEND,
1045 0666,
1046 sub {
1047 $fh = shift
1048 or do {
1049 $disable = 1;
1050 AE::log 4 => "unable to open logfile '$path': $!";
1051 undef $disable;
1052 return;
1053 };
1054
1055 $write->();
1056 }
1057 ;
1058 }
1059 };
1060
1061 $ctx->log_cb (sub {
1062 return if $disable;
1063 push @queue, shift;
1064 $kick->($kick) unless $delay;
1065 0
1066 });
1067
1068 $kick->($kick) if $keepopen; # initial open
1069 };
1070 };
1071 die if $@;
1072 &_log_to_disk
1073}
1074
900sub log_to_file { 1075sub log_to_file {
901 my ($ctx, $path) = @_; 1076 my ($ctx, $path) = @_;
902 1077
903 open my $fh, ">>", $path 1078 _log_to_disk $ctx, $path, 1;
904 or die "$path: $!";
905
906 $ctx->log_cb (sub {
907 syswrite $fh, shift;
908 0
909 });
910} 1079}
911 1080
912sub log_to_path { 1081sub log_to_path {
913 my ($ctx, $path) = @_; 1082 my ($ctx, $path) = @_;
914 1083
915 $ctx->log_cb (sub { 1084 _log_to_disk $ctx, $path, 0;
916 open my $fh, ">>", $path
917 or die "$path: $!";
918
919 syswrite $fh, shift;
920 0
921 });
922} 1085}
923 1086
924sub log_to_syslog { 1087sub log_to_syslog {
925 my ($ctx, $flags) = @_; 1088 my ($ctx, $facility) = @_;
926 1089
927 require Sys::Syslog; 1090 require Sys::Syslog;
928 1091
929 $ctx->fmt_cb (sub { 1092 $ctx->fmt_cb (sub {
930 my $str = $_[3]; 1093 my $str = $_[3];
931 $str =~ s/\n(?=.)/\n+ /g; 1094 $str =~ s/\n(?=.)/\n+ /g;
932 1095
933 [$_[2], "($_[1][0]) $str"] 1096 [$_[2], "($_[1][0]) $str"]
934 }); 1097 });
935 1098
1099 $facility ||= "user";
1100
936 $ctx->log_cb (sub { 1101 $ctx->log_cb (sub {
937 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8; 1102 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
938 1103
939 Sys::Syslog::syslog ($flags | ($lvl - 1), $_) 1104 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
940 for split /\n/, $_[0][1]; 1105 for split /\n/, $_[0][1];
941 1106
942 0 1107 0
943 }); 1108 });
944} 1109}
… …
953=over 4 1118=over 4
954 1119
955=item $ctx->log ($level, $msg[, @params]) 1120=item $ctx->log ($level, $msg[, @params])
956 1121
957Same as C<AnyEvent::Log::log>, but uses the given context as log context. 1122Same as C<AnyEvent::Log::log>, but uses the given context as log context.
1123
1124Example: log a message in the context of another package.
1125
1126 (AnyEvent::Log::ctx "Other::Package")->log (warn => "heely bo");
958 1127
959=item $logger = $ctx->logger ($level[, \$enabled]) 1128=item $logger = $ctx->logger ($level[, \$enabled])
960 1129
961Same as C<AnyEvent::Log::logger>, but uses the given context as log 1130Same as C<AnyEvent::Log::logger>, but uses the given context as log
962context. 1131context.
… …
1050=item C<nolog> 1219=item C<nolog>
1051 1220
1052Configures the context to not log anything by itself, which is the 1221Configures the context to not log anything by itself, which is the
1053default. Same as C<< $ctx->log_cb (undef) >>. 1222default. Same as C<< $ctx->log_cb (undef) >>.
1054 1223
1224=item C<cap=>I<level>
1225
1226Caps logging messages entering this context at the given level, i.e.
1227reduces the priority of messages with higher priority than this level. The
1228default is C<0> (or C<off>), meaning the priority will not be touched.
1229
1055=item C<0> or C<off> 1230=item C<0> or C<off>
1056 1231
1057Sets the logging level of the context ot C<0>, i.e. all messages will be 1232Sets the logging level of the context to C<0>, i.e. all messages will be
1058filtered out. 1233filtered out.
1059 1234
1060=item C<all> 1235=item C<all>
1061 1236
1062Enables all logging levels, i.e. filtering will effectively be switched 1237Enables all logging levels, i.e. filtering will effectively be switched
… …
1104 1279
1105Attaches the named context as slave to the context. 1280Attaches the named context as slave to the context.
1106 1281
1107=item C<+> 1282=item C<+>
1108 1283
1109A line C<+> detaches all contexts, i.e. clears the slave list from the 1284A lone C<+> detaches all contexts, i.e. clears the slave list from the
1110context. Anonymous (C<%name>) contexts have no attached slaves by default, 1285context. Anonymous (C<%name>) contexts have no attached slaves by default,
1111but package contexts have the parent context as slave by default. 1286but package contexts have the parent context as slave by default.
1112 1287
1113Example: log messages from My::Module to a file, do not send them to the 1288Example: log messages from My::Module to a file, do not send them to the
1114default log collector. 1289default log collector.
… …
1145 1320
1146 my $pkg = sub { 1321 my $pkg = sub {
1147 $_[0] eq "log" ? $LOG 1322 $_[0] eq "log" ? $LOG
1148 : $_[0] eq "filter" ? $FILTER 1323 : $_[0] eq "filter" ? $FILTER
1149 : $_[0] eq "collect" ? $COLLECT 1324 : $_[0] eq "collect" ? $COLLECT
1150 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef) 1325 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1151 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/ 1326 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1152 : die # never reached? 1327 : die # never reached?
1153 }; 1328 };
1154 1329
1155 /\G[[:space:]]+/gc; # skip initial whitespace 1330 /\G[[:space:]]+/gc; # skip initial whitespace
… …
1161 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) { 1336 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1162 for ("$1") { 1337 for ("$1") {
1163 if ($_ eq "stderr" ) { $ctx->log_to_warn; 1338 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1164 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1"); 1339 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1165 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1"); 1340 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1166 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog (eval "package Sys::Syslog; $1"); 1341 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1167 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef); 1342 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1343 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1168 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1")); 1344 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1169 } elsif ($_ eq "+" ) { $ctx->slaves; 1345 } elsif ($_ eq "+" ) { $ctx->slaves;
1170 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0); 1346 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1171 } elsif ($_ eq "all" ) { $ctx->level ("all"); 1347 } elsif ($_ eq "all" ) { $ctx->level ("all");
1172 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level"; 1348 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
… …
1189 if (/\G(.+)/g) { 1365 if (/\G(.+)/g) {
1190 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n"; 1366 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1191 } 1367 }
1192} 1368}
1193 1369
11941;
1195
1196=head1 EXAMPLES 1370=head1 EXAMPLES
1197 1371
1198This section shows some common configurations, both as code, and as 1372This section shows some common configurations, both as code, and as
1199C<PERL_ANYEVENT_LOG> string. 1373C<PERL_ANYEVENT_LOG> string.
1200 1374
… …
1224 1398
1225This writes them only when the global logging level allows it, because 1399This writes them only when the global logging level allows it, because
1226it is attached to the default context which is invoked I<after> global 1400it is attached to the default context which is invoked I<after> global
1227filtering. 1401filtering.
1228 1402
1229 $AnyEvent::Log::FILTER->attach 1403 $AnyEvent::Log::FILTER->attach (
1230 new AnyEvent::Log::Ctx log_to_file => $path); 1404 new AnyEvent::Log::Ctx log_to_file => $path);
1231 1405
1232 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path 1406 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
1233 1407
1234This writes them regardless of the global logging level, because it is 1408This writes them regardless of the global logging level, because it is
… …
1240 1414
1241 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger 1415 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1242 1416
1243In both cases, messages are still written to STDERR. 1417In both cases, messages are still written to STDERR.
1244 1418
1419=item Additionally log all messages with C<warn> and higher priority to
1420C<syslog>, but cap at C<error>.
1421
1422This logs all messages to the default log target, but also logs messages
1423with priority C<warn> or higher (and not filtered otherwise) to syslog
1424facility C<user>. Messages with priority higher than C<error> will be
1425logged with level C<error>.
1426
1427 $AnyEvent::Log::LOG->attach (
1428 new AnyEvent::Log::Ctx
1429 level => "warn",
1430 cap => "error",
1431 syslog => "user",
1432 );
1433
1434 PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog
1435
1245=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). 1436=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
1246 1437
1247Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1438Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
1248context - this simply circumvents the global filtering for trace messages. 1439context - this simply circumvents the global filtering for trace messages.
1249 1440
… …
1259=back 1450=back
1260 1451
1261=head1 AUTHOR 1452=head1 AUTHOR
1262 1453
1263 Marc Lehmann <schmorp@schmorp.de> 1454 Marc Lehmann <schmorp@schmorp.de>
1264 http://home.schmorp.de/ 1455 http://software.schmorp.de/pkg/AnyEvent.html
1265 1456
1266=cut 1457=cut
1267 1458
14591
1460

Diff Legend

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