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.37 by root, Thu Aug 25 06:34:11 2011 UTC vs.
Revision 1.50 by root, Thu Mar 22 01:24:19 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 trace => "going to call function abc";
12 AE::log warn => "it's a bit too hot"; 12 AE::log debug => "the function returned 3";
13 AE::log error => "the flag was false!"; 13 AE::log info => "file soandso successfully deleted";
14 AE::log fatal => "the bit toggled! run!"; # never returns 14 AE::log note => "wanted to create config, but config was already created";
15 AE::log warn => "couldn't delete the file";
16 AE::log error => "failed to retrieve data";
17 AE::log crit => "the battery temperature is too hot";
18 AE::log alert => "the battery died";
19 AE::log fatal => "no config found, cannot continue"; # never returns
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<3> (C<critical>), so little
49will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number 67will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
50before starting your program, or change the logging level at runtime with 68before starting your program, or change the logging level at runtime with
51something like: 69something like:
52 70
53 use AnyEvent::Log; 71 use AnyEvent::Log;
… …
72numerical value". 90numerical value".
73 91
74Instead of specifying levels by name you can also specify them by aliases: 92Instead of specifying levels by name you can also specify them by aliases:
75 93
76 LVL NAME SYSLOG PERL NOTE 94 LVL NAME SYSLOG PERL NOTE
77 1 fatal emerg exit aborts program! 95 1 fatal emerg exit system unusable, aborts program!
78 2 alert 96 2 alert failure in primary system
79 3 critical crit 97 3 critical crit failure in backup system
80 4 error err die 98 4 error err die non-urgent program errors, a bug
81 5 warn warning 99 5 warn warning possible problem, not necessarily error
82 6 note notice 100 6 note notice unusual conditions
83 7 info 101 7 info normal messages, no action required
84 8 debug 102 8 debug debugging messages for development
85 9 trace 103 9 trace copious tracing output
86 104
87As you can see, some logging levels have multiple aliases - the first one 105As 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) 106is 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 107and the third one the "perl" name, suggesting (only!) that you log C<die>
90at C<error> priority. 108messages at C<error> priority. The NOTE column tries to provide some
109rationale on how to chose a logging level.
91 110
111As a rough guideline, levels 1..3 are primarily meant for users of the
112program (admins, staff), and are the only ones logged to STDERR by
113default. Levels 4..6 are meant for users and developers alike, while
114levels 7..9 are usually meant for developers.
115
92You can normally only log a single message at highest priority level 116You 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 117C<fatal>), because logging a fatal message will also quit the program - so
94program - so use it sparingly :) 118use it sparingly :)
95 119
96Some methods also offer some extra levels, such as C<0>, C<off>, C<none> 120Some 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. 121or C<all> - these are only valid for the methods that documented them.
98 122
99=head1 LOGGING FUNCTIONS 123=head1 LOGGING FUNCTIONS
100 124
101These functions allow you to log messages. They always use the caller's 125The following functions allow you to log messages. They always use the
102package as a "logging context". Also, the main logging function C<log> is 126caller'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 127C<log>, is aliased to C<AnyEvent::log> and C<AE::log> when the C<AnyEvent>
104loaded. 128module is loaded.
105 129
106=over 4 130=over 4
107 131
108=cut 132=cut
109 133
110package AnyEvent::Log; 134package AnyEvent::Log;
111 135
112use Carp (); 136use Carp ();
113use POSIX (); 137use POSIX ();
138
139# layout of a context
140# 0 1 2 3 4, 5
141# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
114 142
115use AnyEvent (); BEGIN { AnyEvent::common_sense } 143use AnyEvent (); BEGIN { AnyEvent::common_sense }
116#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log 144#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
117 145
118our $VERSION = $AnyEvent::VERSION; 146our $VERSION = $AnyEvent::VERSION;
… …
151=item AnyEvent::Log::log $level, $msg[, @args] 179=item AnyEvent::Log::log $level, $msg[, @args]
152 180
153Requests logging of the given C<$msg> with the given log level, and 181Requests logging of the given C<$msg> with the given log level, and
154returns true if the message was logged I<somewhere>. 182returns true if the message was logged I<somewhere>.
155 183
156For C<fatal> log levels, the program will abort. 184For loglevel C<fatal>, the program will abort.
157 185
158If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the 186If 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. 187C<$msg> is interpreted as an sprintf format string.
160 188
161The C<$msg> should not end with C<\n>, but may if that is convenient for 189The C<$msg> should not end with C<\n>, but may if that is convenient for
… …
163 191
164Last not least, C<$msg> might be a code reference, in which case it is 192Last 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 193supposed 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 194actually gets logged, which is useful if it is costly to create the
167message in the first place. 195message in the first place.
196
197This function takes care of saving and restoring C<$!> and C<$@>, so you
198don't have to.
168 199
169Whether the given message will be logged depends on the maximum log level 200Whether 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 201and 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 202messages 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 203runtime error it tries to log it at C<die> level, but if that message is
… …
206 info => 7, 237 info => 7,
207 debug => 8, 238 debug => 8,
208 trace => 9, 239 trace => 9,
209); 240);
210 241
211sub now () { time } 242our $TIME_EXACT;
243
244sub exact_time($) {
245 $TIME_EXACT = shift;
246 *_ts = $AnyEvent::MODEL
247 ? $TIME_EXACT ? \&AE::now : \&AE::time
248 : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
249}
250
251BEGIN {
252 exact_time 0;
253}
212 254
213AnyEvent::post_detect { 255AnyEvent::post_detect {
214 *now = \&AE::now; 256 exact_time $TIME_EXACT;
215}; 257};
216 258
217our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 259our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
218 260
219# time, ctx, level, msg 261# time, ctx, level, msg
… …
229 } 271 }
230 272
231 join "", @res 273 join "", @res
232} 274}
233 275
276sub fatal_exit() {
277 exit 1;
278}
279
234sub _log { 280sub _log {
235 my ($ctx, $level, $format, @args) = @_; 281 my ($ctx, $level, $format, @args) = @_;
236 282
237 $level = $level > 0 && $level <= 9 283 $level = $level > 0 && $level <= 9
238 ? $level+0 284 ? $level+0
239 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 285 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
240 286
241 my $mask = 1 << $level; 287 my $mask = 1 << $level;
242 288
243 my ($success, %seen, @ctx, $now, $fmt); 289 my ($success, %seen, @ctx, $now, @fmt);
244 290
245 do 291 do
246 { 292 {
247 # skip if masked 293 # if !ref, then it's a level number
294 if (!ref $ctx) {
295 $level = $ctx;
248 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) { 296 } elsif ($ctx->[1] & $mask and !$seen{$ctx+0}++) {
297 # logging/recursing into this context
298
299 # level cap
300 if ($ctx->[5] > $level) {
301 push @ctx, $level; # restore level when going up in tree
302 $level = $ctx->[5];
303 }
304
305 # log if log cb
249 if ($ctx->[3]) { 306 if ($ctx->[3]) {
250 # logging target found 307 # logging target found
308
309 local ($!, $@);
251 310
252 # now get raw message, unless we have it already 311 # now get raw message, unless we have it already
253 unless ($now) { 312 unless ($now) {
254 $format = $format->() if ref $format; 313 $format = $format->() if ref $format;
255 $format = sprintf $format, @args if @args; 314 $format = sprintf $format, @args if @args;
256 $format =~ s/\n$//; 315 $format =~ s/\n$//;
257 $now = now; 316 $now = _ts;
258 }; 317 };
259 318
260 # format msg 319 # format msg
261 my $str = $ctx->[4] 320 my $str = $ctx->[4]
262 ? $ctx->[4]($now, $_[0], $level, $format) 321 ? $ctx->[4]($now, $_[0], $level, $format)
263 : ($fmt ||= _format $now, $_[0], $level, $format); 322 : ($fmt[$level] ||= _format $now, $_[0], $level, $format);
264 323
265 $success = 1; 324 $success = 1;
266 325
267 $ctx->[3]($str) 326 $ctx->[3]($str)
268 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 327 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
… …
271 } 330 }
272 } 331 }
273 } 332 }
274 while $ctx = pop @ctx; 333 while $ctx = pop @ctx;
275 334
276 exit 1 if $level <= 1; 335 fatal_exit if $level <= 1;
277 336
278 $success 337 $success
279} 338}
280 339
281sub log($$;@) { 340sub log($$;@) {
282 _log 341 _log
283 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 342 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
284 @_; 343 @_;
285} 344}
286 345
287*AnyEvent::log = *AE::log = \&log;
288
289=item $logger = AnyEvent::Log::logger $level[, \$enabled] 346=item $logger = AnyEvent::Log::logger $level[, \$enabled]
290 347
291Creates a code reference that, when called, acts as if the 348Creates a code reference that, when called, acts as if the
292C<AnyEvent::Log::log> function was called at this point with the given 349C<AnyEvent::Log::log> function was called at this point with the given
293level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with 350level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
… …
357 414
358 $LOGGER{$logger+0} = $logger; 415 $LOGGER{$logger+0} = $logger;
359 416
360 _reassess $logger+0; 417 _reassess $logger+0;
361 418
362 require AnyEvent::Util; 419 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
363 my $guard = AnyEvent::Util::guard (sub { 420 my $guard = AnyEvent::Util::guard (sub {
364 # "clean up" 421 # "clean up"
365 delete $LOGGER{$logger+0}; 422 delete $LOGGER{$logger+0};
366 }); 423 });
367 424
… …
376sub logger($;$) { 433sub logger($;$) {
377 _logger 434 _logger
378 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 435 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
379 @_ 436 @_
380} 437}
438
439=item AnyEvent::Log::exact_time $on
440
441By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
442eventloop time, for the log timestamps. After calling this function with a
443true value it will instead resort to C<AE::time>, i.e. fetch the current
444time on each log message. This only makes a difference for event loops
445that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
446
447This setting can be changed at any time by calling this function.
448
449Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
450initialised, this switch will also decide whether to use C<CORE::time> or
451C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
452available.
381 453
382=back 454=back
383 455
384=head1 LOGGING CONTEXTS 456=head1 LOGGING CONTEXTS
385 457
… …
505This can be used to implement config-file (re-)loading: before loading a 577This can be used to implement config-file (re-)loading: before loading a
506configuration, reset all contexts. 578configuration, reset all contexts.
507 579
508=cut 580=cut
509 581
582our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
583$AnyEvent::VERBOSE = 9;
584
510sub reset { 585sub reset {
511 # hard to kill complex data structures 586 # hard to kill complex data structures
512 # we "recreate" all package loggers and reset the hierarchy 587 # we "recreate" all package loggers and reset the hierarchy
513 while (my ($k, $v) = each %CTX) { 588 while (my ($k, $v) = each %CTX) {
514 @$v = ($k, (1 << 10) - 1 - 1, { }); 589 @$v = ($k, (1 << 10) - 1 - 1, { });
… …
523 $LOG->title ('$AnyEvent::Log::LOG'); 598 $LOG->title ('$AnyEvent::Log::LOG');
524 $LOG->log_to_warn; 599 $LOG->log_to_warn;
525 600
526 $FILTER->slaves ($LOG); 601 $FILTER->slaves ($LOG);
527 $FILTER->title ('$AnyEvent::Log::FILTER'); 602 $FILTER->title ('$AnyEvent::Log::FILTER');
528 $FILTER->level ($AnyEvent::VERBOSE); 603 $FILTER->level ($ORIG_VERBOSE);
529 604
530 $COLLECT->slaves ($FILTER); 605 $COLLECT->slaves ($FILTER);
531 $COLLECT->title ('$AnyEvent::Log::COLLECT'); 606 $COLLECT->title ('$AnyEvent::Log::COLLECT');
532 607
533 _reassess; 608 _reassess;
534} 609}
610
611# override AE::log/logger
612*AnyEvent::log = *AE::log = \&log;
613*AnyEvent::logger = *AE::logger = \&logger;
614
615# convert AnyEvent loggers to AnyEvent::Log loggers
616$_->[0] = ctx $_->[0] # convert "pkg" to "ctx"
617 for values %LOGGER;
535 618
536# create the default logger contexts 619# create the default logger contexts
537$LOG = ctx undef; 620$LOG = ctx undef;
538$FILTER = ctx undef; 621$FILTER = ctx undef;
539$COLLECT = ctx undef; 622$COLLECT = ctx undef;
… …
548package AnyEvent::Log::COLLECT; 631package AnyEvent::Log::COLLECT;
549package AE::Log::COLLECT; 632package AE::Log::COLLECT;
550 633
551package AnyEvent::Log::Ctx; 634package AnyEvent::Log::Ctx;
552 635
553# 0 1 2 3 4
554# [$title, $level, %$slaves, &$logcb, &$fmtcb]
555
556=item $ctx = new AnyEvent::Log::Ctx methodname => param... 636=item $ctx = new AnyEvent::Log::Ctx methodname => param...
557 637
558This is a convenience constructor that makes it simpler to construct 638This is a convenience constructor that makes it simpler to construct
559anonymous logging contexts. 639anonymous logging contexts.
560 640
… …
647 727
648=item $ctx->disable ($level[, $level...]) 728=item $ctx->disable ($level[, $level...])
649 729
650Disables logging for the given levels, leaving all others unchanged. 730Disables logging for the given levels, leaving all others unchanged.
651 731
732=item $ctx->cap ($level)
733
734Caps the maximum priority to the given level, for all messages logged
735to, or passing through, this context. That is, while this doesn't affect
736whether a message is logged or passed on, the maximum priority of messages
737will be limited to the specified level - messages with a higher priority
738will be set to the specified priority.
739
740Another way to view this is that C<< ->level >> filters out messages with
741a too low priority, while C<< ->cap >> modifies messages with a too high
742priority.
743
744This is useful when different log targets have different interpretations
745of priority. For example, for a specific command line program, a wrong
746command line switch might well result in a C<fatal> log message, while the
747same message, logged to syslog, is likely I<not> fatal to the system or
748syslog facility as a whole, but more likely a mere C<error>.
749
750This can be modeled by having a stderr logger that logs messages "as-is"
751and a syslog logger that logs messages with a level cap of, say, C<error>,
752or, for truly system-critical components, actually C<critical>.
753
652=cut 754=cut
653 755
654sub _lvl_lst { 756sub _lvl_lst {
655 map { 757 map {
656 $_ > 0 && $_ <= 9 ? $_+0 758 $_ > 0 && $_ <= 9 ? $_+0
657 : $_ eq "all" ? (1 .. 9) 759 : $_ eq "all" ? (1 .. 9)
658 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 760 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
659 } @_ 761 } @_
660} 762}
661 763
764sub _lvl {
765 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
766}
767
662our $NOP_CB = sub { 0 }; 768our $NOP_CB = sub { 0 };
663 769
664sub levels { 770sub levels {
665 my $ctx = shift; 771 my $ctx = shift;
666 $ctx->[1] = 0; 772 $ctx->[1] = 0;
… …
669 AnyEvent::Log::_reassess; 775 AnyEvent::Log::_reassess;
670} 776}
671 777
672sub level { 778sub level {
673 my $ctx = shift; 779 my $ctx = shift;
674 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
675
676 $ctx->[1] = ((1 << $lvl) - 1) << 1; 780 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
677 AnyEvent::Log::_reassess; 781 AnyEvent::Log::_reassess;
678} 782}
679 783
680sub enable { 784sub enable {
681 my $ctx = shift; 785 my $ctx = shift;
… …
689 $ctx->[1] &= ~(1 << $_) 793 $ctx->[1] &= ~(1 << $_)
690 for &_lvl_lst; 794 for &_lvl_lst;
691 AnyEvent::Log::_reassess; 795 AnyEvent::Log::_reassess;
692} 796}
693 797
798sub cap {
799 my $ctx = shift;
800 $ctx->[5] = &_lvl;
801}
802
694=back 803=back
695 804
696=head3 SLAVE CONTEXTS 805=head3 SLAVE CONTEXTS
697 806
698The following methods attach and detach another logging context to a 807The following methods attach and detach another logging context to a
… …
785 894
786Replaces the formatting callback on the context (C<undef> restores the 895Replaces the formatting callback on the context (C<undef> restores the
787default formatter). 896default formatter).
788 897
789The callback is passed the (possibly fractional) timestamp, the original 898The callback is passed the (possibly fractional) timestamp, the original
790logging context, the (numeric) logging level and the raw message string 899logging context (object, not title), the (numeric) logging level and
791and needs to return a formatted log message. In most cases this will be a 900the raw message string and needs to return a formatted log message. In
792string, but it could just as well be an array reference that just stores 901most cases this will be a string, but it could just as well be an array
793the values. 902reference that just stores the values.
794 903
795If, for some reason, you want to use C<caller> to find out more baout the 904If, for some reason, you want to use C<caller> to find out more about the
796logger then you should walk up the call stack until you are no longer 905logger then you should walk up the call stack until you are no longer
797inside the C<AnyEvent::Log> package. 906inside the C<AnyEvent::Log> package.
798 907
799Example: format just the raw message, with numeric log level in angle 908Example: format just the raw message, with numeric log level in angle
800brackets. 909brackets.
… …
804 913
805 "<$lvl>$msg\n" 914 "<$lvl>$msg\n"
806 }); 915 });
807 916
808Example: return an array reference with just the log values, and use 917Example: return an array reference with just the log values, and use
809C<PApp::SQL::sql_exec> to store the emssage in a database. 918C<PApp::SQL::sql_exec> to store the message in a database.
810 919
811 $ctx->fmt_cb (sub { \@_ }); 920 $ctx->fmt_cb (sub { \@_ });
812 $ctx->log_cb (sub { 921 $ctx->log_cb (sub {
813 my ($msg) = @_; 922 my ($msg) = @_;
814 923
… …
838 947
839Needless(?) to say, if you do not want to be bitten by some evil person 948Needless(?) to say, if you do not want to be bitten by some evil person
840calling C<chdir>, the path should be absolute. Doesn't help with 949calling C<chdir>, the path should be absolute. Doesn't help with
841C<chroot>, but hey... 950C<chroot>, but hey...
842 951
843=item $ctx->log_to_syslog ([$log_flags]) 952=item $ctx->log_to_syslog ([$facility])
844 953
845Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all 954Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
846the others in the obvious way. If specified, then the C<$log_flags> are 955all the others in the obvious way. If specified, then the C<$facility> is
847simply or'ed onto the priority argument and can contain any C<LOG_xxx> 956used as the facility (C<user>, C<auth>, C<local0> and so on). The default
848flags valid for Sys::Syslog::syslog, except for the priority levels. 957facility is C<user>.
849 958
850Note that this function also sets a C<fmt_cb> - the logging part requires 959Note that this function also sets a C<fmt_cb> - the logging part requires
851an array reference with [$level, $str] as input. 960an array reference with [$level, $str] as input.
852 961
853=cut 962=cut
… …
896 0 1005 0
897 }); 1006 });
898} 1007}
899 1008
900sub log_to_syslog { 1009sub log_to_syslog {
901 my ($ctx, $flags) = @_; 1010 my ($ctx, $facility) = @_;
902 1011
903 require Sys::Syslog; 1012 require Sys::Syslog;
904 1013
905 $ctx->fmt_cb (sub { 1014 $ctx->fmt_cb (sub {
906 my $str = $_[3]; 1015 my $str = $_[3];
907 $str =~ s/\n(?=.)/\n+ /g; 1016 $str =~ s/\n(?=.)/\n+ /g;
908 1017
909 [$_[2], "($_[1][0]) $str"] 1018 [$_[2], "($_[1][0]) $str"]
910 }); 1019 });
911 1020
1021 $facility ||= "user";
1022
912 $ctx->log_cb (sub { 1023 $ctx->log_cb (sub {
913 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8; 1024 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
914 1025
915 Sys::Syslog::syslog ($flags | ($lvl - 1), $_) 1026 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
916 for split /\n/, $_[0][1]; 1027 for split /\n/, $_[0][1];
917 1028
918 0 1029 0
919 }); 1030 });
920} 1031}
… …
1026=item C<nolog> 1137=item C<nolog>
1027 1138
1028Configures the context to not log anything by itself, which is the 1139Configures the context to not log anything by itself, which is the
1029default. Same as C<< $ctx->log_cb (undef) >>. 1140default. Same as C<< $ctx->log_cb (undef) >>.
1030 1141
1142=item C<cap=>I<level>
1143
1144Caps logging messages entering this context at the given level, i.e.
1145reduces the priority of messages with higher priority than this level. The
1146default is C<0> (or C<off>), meaning the priority will not be touched.
1147
1031=item C<0> or C<off> 1148=item C<0> or C<off>
1032 1149
1033Sets the logging level of the context ot C<0>, i.e. all messages will be 1150Sets the logging level of the context to C<0>, i.e. all messages will be
1034filtered out. 1151filtered out.
1035 1152
1036=item C<all> 1153=item C<all>
1037 1154
1038Enables all logging levels, i.e. filtering will effectively be switched 1155Enables all logging levels, i.e. filtering will effectively be switched
… …
1080 1197
1081Attaches the named context as slave to the context. 1198Attaches the named context as slave to the context.
1082 1199
1083=item C<+> 1200=item C<+>
1084 1201
1085A line C<+> detaches all contexts, i.e. clears the slave list from the 1202A lone C<+> detaches all contexts, i.e. clears the slave list from the
1086context. Anonymous (C<%name>) contexts have no attached slaves by default, 1203context. Anonymous (C<%name>) contexts have no attached slaves by default,
1087but package contexts have the parent context as slave by default. 1204but package contexts have the parent context as slave by default.
1088 1205
1089Example: log messages from My::Module to a file, do not send them to the 1206Example: log messages from My::Module to a file, do not send them to the
1090default log collector. 1207default log collector.
… …
1121 1238
1122 my $pkg = sub { 1239 my $pkg = sub {
1123 $_[0] eq "log" ? $LOG 1240 $_[0] eq "log" ? $LOG
1124 : $_[0] eq "filter" ? $FILTER 1241 : $_[0] eq "filter" ? $FILTER
1125 : $_[0] eq "collect" ? $COLLECT 1242 : $_[0] eq "collect" ? $COLLECT
1126 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef) 1243 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1127 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/ 1244 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1128 : die # never reached? 1245 : die # never reached?
1129 }; 1246 };
1130 1247
1131 /\G[[:space:]]+/gc; # skip initial whitespace 1248 /\G[[:space:]]+/gc; # skip initial whitespace
… …
1137 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) { 1254 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1138 for ("$1") { 1255 for ("$1") {
1139 if ($_ eq "stderr" ) { $ctx->log_to_warn; 1256 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1140 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1"); 1257 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1141 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1"); 1258 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1142 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog (eval "package Sys::Syslog; $1"); 1259 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1143 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef); 1260 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1261 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1144 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1")); 1262 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1145 } elsif ($_ eq "+" ) { $ctx->slaves; 1263 } elsif ($_ eq "+" ) { $ctx->slaves;
1146 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0); 1264 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1147 } elsif ($_ eq "all" ) { $ctx->level ("all"); 1265 } elsif ($_ eq "all" ) { $ctx->level ("all");
1148 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level"; 1266 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
… …
1200 1318
1201This writes them only when the global logging level allows it, because 1319This writes them only when the global logging level allows it, because
1202it is attached to the default context which is invoked I<after> global 1320it is attached to the default context which is invoked I<after> global
1203filtering. 1321filtering.
1204 1322
1205 $AnyEvent::Log::FILTER->attach 1323 $AnyEvent::Log::FILTER->attach (
1206 new AnyEvent::Log::Ctx log_to_file => $path); 1324 new AnyEvent::Log::Ctx log_to_file => $path);
1207 1325
1208 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path 1326 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
1209 1327
1210This writes them regardless of the global logging level, because it is 1328This writes them regardless of the global logging level, because it is
… …
1216 1334
1217 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger 1335 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1218 1336
1219In both cases, messages are still written to STDERR. 1337In both cases, messages are still written to STDERR.
1220 1338
1339=item Additionally log all messages with C<warn> and higher priority to
1340C<syslog>, but cap at C<error>.
1341
1342This logs all messages to the default log target, but also logs messages
1343with priority C<warn> or higher (and not filtered otherwise) to syslog
1344facility C<user>. Messages with priority higher than C<error> will be
1345logged with level C<error>.
1346
1347 $AnyEvent::Log::LOG->attach (
1348 new AnyEvent::Log::Ctx
1349 level => "warn",
1350 cap => "error",
1351 syslog => "user",
1352 );
1353
1354 PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog
1355
1221=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). 1356=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
1222 1357
1223Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1358Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
1224context - this simply circumvents the global filtering for trace messages. 1359context - this simply circumvents the global filtering for trace messages.
1225 1360

Diff Legend

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