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.43 by root, Mon Sep 5 07:21:54 2011 UTC vs.
Revision 1.64 by root, Sun Mar 13 04:48:43 2016 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
16 # available log levels in order: 21Log level overview:
17 # fatal alert critical error warn note info debug trace
18
19"Complex" uses (for speed sensitive code):
20
21 use AnyEvent::Log;
22
23 my $tracer = AnyEvent::Log::logger trace => \$my $trace;
24
25 $tracer->("i am here") if $trace;
26 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
27
28Configuration (also look at the EXAMPLES section):
29
30 # set logging for the current package to errors and higher only
31 AnyEvent::Log::ctx->level ("error");
32
33 # set logging level to suppress anything below "notice"
34 $AnyEvent::Log::FILTER->level ("notice");
35
36 # send all critical and higher priority messages to syslog,
37 # regardless of (most) other settings
38 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
39 level => "critical",
40 log_to_syslog => "user",
41 );
42
43=head1 DESCRIPTION
44
45This module implements a relatively simple "logging framework". It doesn't
46attempt to be "the" logging solution or even "a" logging solution for
47AnyEvent - AnyEvent simply creates logging messages internally, and this
48module more or less exposes the mechanism, with some extra spiff to allow
49using it from other modules as well.
50
51Remember that the default verbosity level is C<0> (C<off>), so nothing
52will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
53before starting your program, or change the logging level at runtime with
54something like:
55
56 use AnyEvent::Log;
57 $AnyEvent::Log::FILTER->level ("info");
58
59The design goal behind this module was to keep it simple (and small),
60but make it powerful enough to be potentially useful for any module, and
61extensive enough for the most common tasks, such as logging to multiple
62targets, or being able to log into a database.
63
64The module is also usable before AnyEvent itself is initialised, in which
65case some of the functionality might be reduced.
66
67The amount of documentation might indicate otherwise, but the runtime part
68of the module is still just below 300 lines of code.
69
70=head1 LOGGING LEVELS
71
72Logging levels in this module range from C<1> (highest priority) to C<9>
73(lowest priority). Note that the lowest numerical value is the highest
74priority, so when this document says "higher priority" it means "lower
75numerical value".
76
77Instead of specifying levels by name you can also specify them by aliases:
78 22
79 LVL NAME SYSLOG PERL NOTE 23 LVL NAME SYSLOG PERL NOTE
80 1 fatal emerg exit system unusable, aborts program! 24 1 fatal emerg exit system unusable, aborts program!
81 2 alert failure in primary system 25 2 alert failure in primary system
82 3 critical crit failure in backup system 26 3 critical crit failure in backup system
… …
85 6 note notice unusual conditions 29 6 note notice unusual conditions
86 7 info normal messages, no action required 30 7 info normal messages, no action required
87 8 debug debugging messages for development 31 8 debug debugging messages for development
88 9 trace copious tracing output 32 9 trace copious tracing output
89 33
34"Complex" uses (for speed sensitive code, e.g. trace/debug messages):
35
36 use AnyEvent::Log;
37
38 my $tracer = AnyEvent::Log::logger trace => \$my $trace;
39
40 $tracer->("i am here") if $trace;
41 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
42
43Configuration (also look at the EXAMPLES section):
44
45 # set logging for the current package to errors and higher only
46 AnyEvent::Log::ctx->level ("error");
47
48 # set logging level to suppress anything below "notice"
49 $AnyEvent::Log::FILTER->level ("notice");
50
51 # send all critical and higher priority messages to syslog,
52 # regardless of (most) other settings
53 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
54 level => "critical",
55 log_to_syslog => "user",
56 );
57
58=head1 DESCRIPTION
59
60This module implements a relatively simple "logging framework". It doesn't
61attempt to be "the" logging solution or even "a" logging solution for
62AnyEvent - AnyEvent simply creates logging messages internally, and this
63module more or less exposes the mechanism, with some extra spiff to allow
64using it from other modules as well.
65
66Remember that the default verbosity level is C<4> (C<error>), so only
67errors and more important messages will be logged, unless you set
68C<PERL_ANYEVENT_VERBOSE> to a higher number before starting your program
69(C<AE_VERBOSE=5> is recommended during development), or change the logging
70level at runtime with something like:
71
72 use AnyEvent::Log;
73 $AnyEvent::Log::FILTER->level ("info");
74
75The design goal behind this module was to keep it simple (and small),
76but make it powerful enough to be potentially useful for any module,
77and extensive enough for the most common tasks, such as logging to
78multiple targets, or being able to log into a database.
79
80The module is also usable before AnyEvent itself is initialised, in which
81case some of the functionality might be reduced.
82
83The amount of documentation might indicate otherwise, but the runtime part
84of the module is still just below 300 lines of code.
85
86=head1 LOGGING LEVELS
87
88Logging levels in this module range from C<1> (highest priority) to C<9>
89(lowest priority). Note that the lowest numerical value is the highest
90priority, so when this document says "higher priority" it means "lower
91numerical value".
92
93Instead of specifying levels by name you can also specify them by aliases:
94
95 LVL NAME SYSLOG PERL NOTE
96 1 fatal emerg exit system unusable, aborts program!
97 2 alert failure in primary system
98 3 critical crit failure in backup system
99 4 error err die non-urgent program errors, a bug
100 5 warn warning possible problem, not necessarily error
101 6 note notice unusual conditions
102 7 info normal messages, no action required
103 8 debug debugging messages for development
104 9 trace copious tracing output
105
90As 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
91is 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)
92and the third one the "perl" name, suggesting (only!) that you log C<die> 108and the third one the "perl" name, suggesting (only!) that you log C<die>
93messages at C<error> priority. The NOTE column tries to provide some 109messages at C<error> priority. The NOTE column tries to provide some
94rationale on how to chose a logging level. 110rationale on how to chose a logging level.
95 111
96As a rough guideline, levels 1..3 are primarily meant for users of 112As a rough guideline, levels 1..3 are primarily meant for users of the
97the program (admins, staff), and are the only logged to STDERR by 113program (admins, staff), and are the only ones logged to STDERR by
98default. Levels 4..6 are meant for users and developers alike, while 114default. Levels 4..6 are meant for users and developers alike, while
99levels 7..9 are usually meant for developers. 115levels 7..9 are usually meant for developers.
100 116
101You 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>,
102(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
103program - 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.
104 124
105Some 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>
106or 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.
107 127
108=head1 LOGGING FUNCTIONS 128=head1 LOGGING FUNCTIONS
109 129
110These functions allow you to log messages. They always use the caller's 130The following functions allow you to log messages. They always use the
111package as a "logging context". Also, the main logging function C<log> is 131caller's package as a "logging context". Also, the main logging function,
112callable 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>
113loaded. 133module is loaded.
114 134
115=over 4 135=over 4
116 136
117=cut 137=cut
118 138
119package AnyEvent::Log; 139package AnyEvent::Log;
120 140
121use Carp (); 141use Carp ();
122use POSIX (); 142use POSIX ();
123 143
144# layout of a context
145# 0 1 2 3 4, 5
146# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
147
124use AnyEvent (); BEGIN { AnyEvent::common_sense } 148use AnyEvent (); BEGIN { AnyEvent::common_sense }
125#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
126 150
127our $VERSION = $AnyEvent::VERSION; 151our $VERSION = $AnyEvent::VERSION;
128 152
129our ($COLLECT, $FILTER, $LOG); 153our ($COLLECT, $FILTER, $LOG);
130 154
131our ($now_int, $now_str1, $now_str2); 155our ($now_int, $now_str1, $now_str2);
132 156
133# Format Time, not public - yet? 157# Format Time, not public - yet?
134sub ft($) { 158sub format_time($) {
135 my $i = int $_[0]; 159 my $i = int $_[0];
136 my $f = sprintf "%06d", 1e6 * ($_[0] - $i); 160 my $f = sprintf "%06d", 1e6 * ($_[0] - $i);
137 161
138 ($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)
139 if $now_int != $i; 163 if $now_int != $i;
… …
172 196
173Last 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
174supposed 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
175actually 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
176message 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.
177 204
178Whether 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
179and 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
180messages or not "lost" - for example, when L<AnyEvent::Debug> detects a 207messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
181runtime 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
… …
235}; 262};
236 263
237our @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);
238 265
239# time, ctx, level, msg 266# time, ctx, level, msg
240sub _format($$$$) { 267sub default_format($$$$) {
241 my $ts = ft $_[0]; 268 my $ts = format_time $_[0];
242 my $ct = " "; 269 my $ct = " ";
243 270
244 my @res; 271 my @res;
245 272
246 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]) {
… …
262 ? $level+0 289 ? $level+0
263 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 290 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
264 291
265 my $mask = 1 << $level; 292 my $mask = 1 << $level;
266 293
267 my ($success, %seen, @ctx, $now, $fmt); 294 my ($success, %seen, @ctx, $now, @fmt);
268 295
269 do 296 do
270 { 297 {
271 # skip if masked 298 # if !ref, then it's a level number
299 if (!ref $ctx) {
300 $level = $ctx;
272 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
273 if ($ctx->[3]) { 311 if ($ctx->[3]) {
274 # logging target found 312 # logging target found
313
314 local ($!, $@);
275 315
276 # now get raw message, unless we have it already 316 # now get raw message, unless we have it already
277 unless ($now) { 317 unless ($now) {
278 $format = $format->() if ref $format; 318 $format = $format->() if ref $format;
279 $format = sprintf $format, @args if @args; 319 $format = sprintf $format, @args if @args;
… …
282 }; 322 };
283 323
284 # format msg 324 # format msg
285 my $str = $ctx->[4] 325 my $str = $ctx->[4]
286 ? $ctx->[4]($now, $_[0], $level, $format) 326 ? $ctx->[4]($now, $_[0], $level, $format)
287 : ($fmt ||= _format $now, $_[0], $level, $format); 327 : ($fmt[$level] ||= default_format $now, $_[0], $level, $format);
288 328
289 $success = 1; 329 $success = 1;
290 330
291 $ctx->[3]($str) 331 $ctx->[3]($str)
292 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate 332 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
… …
414Since 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
415initialised, 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
416C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes 456C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
417available. 457available.
418 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.
493
419=back 494=back
420 495
421=head1 LOGGING CONTEXTS 496=head1 LOGGING CONTEXTS
422 497
423This module associates every log message with a so-called I<logging 498This module associates every log message with a so-called I<logging
… …
596package AnyEvent::Log::COLLECT; 671package AnyEvent::Log::COLLECT;
597package AE::Log::COLLECT; 672package AE::Log::COLLECT;
598 673
599package AnyEvent::Log::Ctx; 674package AnyEvent::Log::Ctx;
600 675
601# 0 1 2 3 4
602# [$title, $level, %$slaves, &$logcb, &$fmtcb]
603
604=item $ctx = new AnyEvent::Log::Ctx methodname => param... 676=item $ctx = new AnyEvent::Log::Ctx methodname => param...
605 677
606This is a convenience constructor that makes it simpler to construct 678This is a convenience constructor that makes it simpler to construct
607anonymous logging contexts. 679anonymous logging contexts.
608 680
… …
695 767
696=item $ctx->disable ($level[, $level...]) 768=item $ctx->disable ($level[, $level...])
697 769
698Disables logging for the given levels, leaving all others unchanged. 770Disables logging for the given levels, leaving all others unchanged.
699 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
700=cut 794=cut
701 795
702sub _lvl_lst { 796sub _lvl_lst {
703 map { 797 map {
704 $_ > 0 && $_ <= 9 ? $_+0 798 $_ > 0 && $_ <= 9 ? $_+0
705 : $_ eq "all" ? (1 .. 9) 799 : $_ eq "all" ? (1 .. 9)
706 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 800 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
707 } @_ 801 } @_
708} 802}
709 803
804sub _lvl {
805 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
806}
807
710our $NOP_CB = sub { 0 }; 808our $NOP_CB = sub { 0 };
711 809
712sub levels { 810sub levels {
713 my $ctx = shift; 811 my $ctx = shift;
714 $ctx->[1] = 0; 812 $ctx->[1] = 0;
… …
717 AnyEvent::Log::_reassess; 815 AnyEvent::Log::_reassess;
718} 816}
719 817
720sub level { 818sub level {
721 my $ctx = shift; 819 my $ctx = shift;
722 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
723
724 $ctx->[1] = ((1 << $lvl) - 1) << 1; 820 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
725 AnyEvent::Log::_reassess; 821 AnyEvent::Log::_reassess;
726} 822}
727 823
728sub enable { 824sub enable {
729 my $ctx = shift; 825 my $ctx = shift;
… …
737 $ctx->[1] &= ~(1 << $_) 833 $ctx->[1] &= ~(1 << $_)
738 for &_lvl_lst; 834 for &_lvl_lst;
739 AnyEvent::Log::_reassess; 835 AnyEvent::Log::_reassess;
740} 836}
741 837
838sub cap {
839 my $ctx = shift;
840 $ctx->[5] = &_lvl;
841}
842
742=back 843=back
743 844
744=head3 SLAVE CONTEXTS 845=head3 SLAVE CONTEXTS
745 846
746The following methods attach and detach another logging context to a 847The following methods attach and detach another logging context to a
… …
798the logging (which consists of formatting the message and printing it or 899the logging (which consists of formatting the message and printing it or
799whatever it wants to do with it). 900whatever it wants to do with it).
800 901
801=over 4 902=over 4
802 903
803=item $ctx->log_cb ($cb->($str) 904=item $ctx->log_cb ($cb->($str))
804 905
805Replaces the logging callback on the context (C<undef> disables the 906Replaces the logging callback on the context (C<undef> disables the
806logging callback). 907logging callback).
807 908
808The logging callback is responsible for handling formatted log messages 909The logging callback is responsible for handling formatted log messages
… …
833 934
834Replaces the formatting callback on the context (C<undef> restores the 935Replaces the formatting callback on the context (C<undef> restores the
835default formatter). 936default formatter).
836 937
837The callback is passed the (possibly fractional) timestamp, the original 938The callback is passed the (possibly fractional) timestamp, the original
838logging context, the (numeric) logging level and the raw message string 939logging context (object, not title), the (numeric) logging level and
839and 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
840string, 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
841the values. 942reference that just stores the values.
842 943
843If, 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
844logger 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
845inside the C<AnyEvent::Log> package. 946inside the C<AnyEvent::Log> package.
846 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
847Example: format just the raw message, with numeric log level in angle 962Example: format just the raw message, with numeric log level in angle
848brackets. 963brackets.
849 964
850 $ctx->fmt_cb (sub { 965 $ctx->fmt_cb (sub {
851 my ($time, $ctx, $lvl, $msg) = @_; 966 my ($time, $ctx, $lvl, $msg) = @_;
852 967
853 "<$lvl>$msg\n" 968 "<$lvl>$msg\n"
854 }); 969 });
855 970
856Example: return an array reference with just the log values, and use 971Example: return an array reference with just the log values, and use
857C<PApp::SQL::sql_exec> to store the emssage in a database. 972C<PApp::SQL::sql_exec> to store the message in a database.
858 973
859 $ctx->fmt_cb (sub { \@_ }); 974 $ctx->fmt_cb (sub { \@_ });
860 $ctx->log_cb (sub { 975 $ctx->log_cb (sub {
861 my ($msg) = @_; 976 my ($msg) = @_;
862 977
… …
874Sets 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
875(usually this logs to STDERR). 990(usually this logs to STDERR).
876 991
877=item $ctx->log_to_file ($path) 992=item $ctx->log_to_file ($path)
878 993
879Sets 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.
880 996
881=item $ctx->log_to_path ($path) 997=item $ctx->log_to_path ($path)
882 998
883Same 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
884is 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
… …
919 warn shift; 1035 warn shift;
920 0 1036 0
921 }); 1037 });
922} 1038}
923 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
924sub log_to_file { 1124sub log_to_file {
925 my ($ctx, $path) = @_; 1125 my ($ctx, $path) = @_;
926 1126
927 open my $fh, ">>", $path 1127 _log_to_disk $ctx, $path, 1;
928 or die "$path: $!";
929
930 $ctx->log_cb (sub {
931 syswrite $fh, shift;
932 0
933 });
934} 1128}
935 1129
936sub log_to_path { 1130sub log_to_path {
937 my ($ctx, $path) = @_; 1131 my ($ctx, $path) = @_;
938 1132
939 $ctx->log_cb (sub { 1133 _log_to_disk $ctx, $path, 0;
940 open my $fh, ">>", $path
941 or die "$path: $!";
942
943 syswrite $fh, shift;
944 0
945 });
946} 1134}
947 1135
948sub log_to_syslog { 1136sub log_to_syslog {
949 my ($ctx, $facility) = @_; 1137 my ($ctx, $facility) = @_;
950 1138
… …
979=over 4 1167=over 4
980 1168
981=item $ctx->log ($level, $msg[, @params]) 1169=item $ctx->log ($level, $msg[, @params])
982 1170
983Same 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");
984 1176
985=item $logger = $ctx->logger ($level[, \$enabled]) 1177=item $logger = $ctx->logger ($level[, \$enabled])
986 1178
987Same 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
988context. 1180context.
… …
1036 1228
1037Context names starting with a C<%> are anonymous contexts created when the 1229Context names starting with a C<%> are anonymous contexts created when the
1038name is first mentioned. The difference to package contexts is that by 1230name is first mentioned. The difference to package contexts is that by
1039default they have no attached slaves. 1231default they have no attached slaves.
1040 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
1041=item a perl package name 1236=item a perl package name
1042 1237
1043Any other string references the logging context associated with the given 1238Any other string references the logging context associated with the given
1044Perl 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
1045context 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
… …
1076=item C<nolog> 1271=item C<nolog>
1077 1272
1078Configures the context to not log anything by itself, which is the 1273Configures the context to not log anything by itself, which is the
1079default. Same as C<< $ctx->log_cb (undef) >>. 1274default. Same as C<< $ctx->log_cb (undef) >>.
1080 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
1081=item C<0> or C<off> 1282=item C<0> or C<off>
1082 1283
1083Sets 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
1084filtered out. 1285filtered out.
1085 1286
1086=item C<all> 1287=item C<all>
1087 1288
1088Enables all logging levels, i.e. filtering will effectively be switched 1289Enables all logging levels, i.e. filtering will effectively be switched
… …
1130 1331
1131Attaches the named context as slave to the context. 1332Attaches the named context as slave to the context.
1132 1333
1133=item C<+> 1334=item C<+>
1134 1335
1135A 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
1136context. Anonymous (C<%name>) contexts have no attached slaves by default, 1337context. Anonymous (C<%name>) contexts have no attached slaves by default,
1137but package contexts have the parent context as slave by default. 1338but package contexts have the parent context as slave by default.
1138 1339
1139Example: 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
1140default log collector. 1341default log collector.
… …
1171 1372
1172 my $pkg = sub { 1373 my $pkg = sub {
1173 $_[0] eq "log" ? $LOG 1374 $_[0] eq "log" ? $LOG
1174 : $_[0] eq "filter" ? $FILTER 1375 : $_[0] eq "filter" ? $FILTER
1175 : $_[0] eq "collect" ? $COLLECT 1376 : $_[0] eq "collect" ? $COLLECT
1176 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef) 1377 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1177 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/ 1378 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1178 : die # never reached? 1379 : die # never reached?
1179 }; 1380 };
1180 1381
1181 /\G[[:space:]]+/gc; # skip initial whitespace 1382 /\G[[:space:]]+/gc; # skip initial whitespace
… …
1187 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) { 1388 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1188 for ("$1") { 1389 for ("$1") {
1189 if ($_ eq "stderr" ) { $ctx->log_to_warn; 1390 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1190 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1"); 1391 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1191 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1"); 1392 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1192 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ($1); 1393 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1193 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef); 1394 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1395 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1194 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1")); 1396 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1195 } elsif ($_ eq "+" ) { $ctx->slaves; 1397 } elsif ($_ eq "+" ) { $ctx->slaves;
1196 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0); 1398 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1197 } elsif ($_ eq "all" ) { $ctx->level ("all"); 1399 } elsif ($_ eq "all" ) { $ctx->level ("all");
1198 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level"; 1400 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
… …
1215 if (/\G(.+)/g) { 1417 if (/\G(.+)/g) {
1216 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n"; 1418 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1217 } 1419 }
1218} 1420}
1219 1421
12201;
1221
1222=head1 EXAMPLES 1422=head1 EXAMPLES
1223 1423
1224This section shows some common configurations, both as code, and as 1424This section shows some common configurations, both as code, and as
1225C<PERL_ANYEVENT_LOG> string. 1425C<PERL_ANYEVENT_LOG> string.
1226 1426
… …
1266 1466
1267 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger 1467 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1268 1468
1269In both cases, messages are still written to STDERR. 1469In both cases, messages are still written to STDERR.
1270 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
1271=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).
1272 1489
1273Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug> 1490Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
1274context - this simply circumvents the global filtering for trace messages. 1491context - this simply circumvents the global filtering for trace messages.
1275 1492
… …
1282assumes 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
1283default. 1500default.
1284 1501
1285=back 1502=back
1286 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
1287=head1 AUTHOR 1510=head1 AUTHOR
1288 1511
1289 Marc Lehmann <schmorp@schmorp.de> 1512 Marc Lehmann <schmorp@schmorp.de>
1290 http://home.schmorp.de/ 1513 http://anyevent.schmorp.de
1291 1514
1292=cut 1515=cut
1293 1516
15171
1518

Diff Legend

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