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.17 by root, Sat Aug 20 02:21:53 2011 UTC vs.
Revision 1.55 by root, Fri Mar 30 21:31:52 2012 UTC

2 2
3AnyEvent::Log - simple logging "framework" 3AnyEvent::Log - simple logging "framework"
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 # simple use 7Simple uses:
8
8 use AnyEvent; 9 use AnyEvent;
9 10
10 AE::log debug => "hit my knee"; 11 AE::log fatal => "No config found, cannot continue!"; # never returns
11 AE::log warn => "it's a bit too hot"; 12 AE::log alert => "The battery died!";
12 AE::log error => "the flag was false!"; 13 AE::log crit => "The battery temperature is too hot!";
13 AE::log fatal => "the bit toggled! run!"; 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";
14 20
15 # "complex" use 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
34"Complex" uses (for speed sensitive code, e.g. trace/debug messages):
35
16 use AnyEvent::Log; 36 use AnyEvent::Log;
17 37
18 my $tracer = AnyEvent::Log::logger trace => \$my $trace; 38 my $tracer = AnyEvent::Log::logger trace => \$my $trace;
19 39
20 $tracer->("i am here") if $trace; 40 $tracer->("i am here") if $trace;
21 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; 41 $tracer->(sub { "lots of data: " . Dumper $self }) if $trace;
22 42
23 # configuration 43Configuration (also look at the EXAMPLES section):
24 44
25 # set logging for this package to errors and higher only 45 # set logging for the current package to errors and higher only
26 AnyEvent::Log::ctx->level ("error"); 46 AnyEvent::Log::ctx->level ("error");
27 47
28 # set logging globally to anything below debug 48 # set logging level to suppress anything below "notice"
29 $AnyEvent::Log::Root->level ("notice"); 49 $AnyEvent::Log::FILTER->level ("notice");
30 50
31 # see also EXAMPLES, below 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 );
32 57
33=head1 DESCRIPTION 58=head1 DESCRIPTION
34 59
35This module implements a relatively simple "logging framework". It doesn't 60This module implements a relatively simple "logging framework". It doesn't
36attempt to be "the" logging solution or even "a" logging solution for 61attempt to be "the" logging solution or even "a" logging solution for
37AnyEvent - AnyEvent simply creates logging messages internally, and this 62AnyEvent - AnyEvent simply creates logging messages internally, and this
38module 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
39using it from other modules as well. 64using it from other modules as well.
40 65
41Remember that the default verbosity level is C<0>, so nothing will be 66Remember that the default verbosity level is C<4> (C<error>), so only
42logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number before 67errors and more important messages will be logged, unless you set
43starting your program, or change the logging level at runtime with 68C<PERL_ANYEVENT_VERBOSE> to a higher number before starting your program
44something like: 69(C<AE_VERBOSE=5> is recommended during development), or change the logging
70level at runtime with something like:
45 71
46 use AnyEvent; 72 use AnyEvent::Log;
47 (AnyEvent::Log::ctx "")->level ("info"); 73 $AnyEvent::Log::FILTER->level ("info");
48 74
49The 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),
50but make it powerful enough to be potentially useful for any module, and 76but make it powerful enough to be potentially useful for any module, and
51extensive enough for the most common tasks, such as logging to multiple 77extensive enough for the most common tasks, such as logging to multiple
52targets, or being able to log into a database. 78targets, or being able to log into a database.
53 79
80The module is also usable before AnyEvent itself is initialised, in which
81case some of the functionality might be reduced.
82
54The amount of documentation might indicate otherwise, but the module is 83The amount of documentation might indicate otherwise, but the runtime part
55still just 240 lines or so. 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
106As you can see, some logging levels have multiple aliases - the first one
107is the "official" name, the second one the "syslog" name (if it differs)
108and the third one the "perl" name, suggesting (only!) that you log C<die>
109messages at C<error> priority. The NOTE column tries to provide some
110rationale on how to chose a logging level.
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
117You can normally only log a message once at highest priority level (C<1>,
118C<fatal>), because logging a fatal message will also quit the program - so
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.
124
125Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
126or C<all> - these are only valid for the methods that documented them.
56 127
57=head1 LOGGING FUNCTIONS 128=head1 LOGGING FUNCTIONS
58 129
59These functions allow you to log messages. They always use the caller's 130The following functions allow you to log messages. They always use the
60package as a "logging module/source". Also, the main logging function is 131caller's package as a "logging context". Also, the main logging function,
61callable 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>
62loaded. 133module is loaded.
63 134
64=over 4 135=over 4
65 136
66=cut 137=cut
67 138
68package AnyEvent::Log; 139package AnyEvent::Log;
69 140
70use Carp (); 141use Carp ();
71use POSIX (); 142use POSIX ();
72 143
144# layout of a context
145# 0 1 2 3 4, 5
146# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
147
73use AnyEvent (); BEGIN { AnyEvent::common_sense } 148use AnyEvent (); BEGIN { AnyEvent::common_sense }
74use AnyEvent::Util (); 149#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
75 150
76our $VERSION = $AnyEvent::VERSION; 151our $VERSION = $AnyEvent::VERSION;
152
153our ($COLLECT, $FILTER, $LOG);
77 154
78our ($now_int, $now_str1, $now_str2); 155our ($now_int, $now_str1, $now_str2);
79 156
80# Format Time, not public - yet? 157# Format Time, not public - yet?
81sub ft($) { 158sub ft($) {
86 if $now_int != $i; 163 if $now_int != $i;
87 164
88 "$now_str1$f$now_str2" 165 "$now_str1$f$now_str2"
89} 166}
90 167
91our %CTX; # all logging contexts 168our %CTX; # all package contexts
92 169
93# creates a default package context object for the given package 170# creates a default package context object for the given package
94sub _pkg_ctx($) { 171sub _pkg_ctx($) {
95 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx"; 172 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
96 173
97 # link "parent" package 174 # link "parent" package
98 my $pkg = $_[0] =~ /^(.+)::/ ? $1 : "AE::Log::Top"; 175 my $parent = $_[0] =~ /^(.+)::/
176 ? $CTX{$1} ||= &_pkg_ctx ("$1")
177 : $COLLECT;
99 178
100 $pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg);
101 $ctx->[2]{$pkg+0} = $pkg; 179 $ctx->[2]{$parent+0} = $parent;
102 180
103 $ctx 181 $ctx
104} 182}
105 183
106=item AnyEvent::Log::log $level, $msg[, @args] 184=item AnyEvent::Log::log $level, $msg[, @args]
107 185
108Requests logging of the given C<$msg> with the given log level (1..9). 186Requests logging of the given C<$msg> with the given log level, and
109You can also use the following strings as log level: C<fatal> (1), 187returns true if the message was logged I<somewhere>.
110C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
111C<info> (7), C<debug> (8), C<trace> (9).
112 188
113For C<fatal> log levels, the program will abort. 189For loglevel C<fatal>, the program will abort.
114 190
115If 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
116C<$msg> is interpreted as an sprintf format string. 192C<$msg> is interpreted as an sprintf format string.
117 193
118The 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
121Last 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
122supposed 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
123actually 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
124message in the first place. 200message in the first place.
125 201
202This function takes care of saving and restoring C<$!> and C<$@>, so you
203don't have to.
204
126Whether 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
127and the caller's package. 206and the caller's package. The return value can be used to ensure that
207messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
208runtime error it tries to log it at C<die> level, but if that message is
209lost it simply uses warn.
128 210
129Note that you can (and should) call this function as C<AnyEvent::log> or 211Note that you can (and should) call this function as C<AnyEvent::log> or
130C<AE::log>, without C<use>-ing this module if possible (i.e. you don't 212C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
131need any additional functionality), as those functions will load the 213need any additional functionality), as those functions will load the
132logging module on demand only. They are also much shorter to write. 214logging module on demand only. They are also much shorter to write.
149 231
150=cut 232=cut
151 233
152# also allow syslog equivalent names 234# also allow syslog equivalent names
153our %STR2LEVEL = ( 235our %STR2LEVEL = (
154 fatal => 1, emerg => 1, 236 fatal => 1, emerg => 1, exit => 1,
155 alert => 2, 237 alert => 2,
156 critical => 3, crit => 3, 238 critical => 3, crit => 3,
157 error => 4, err => 4, 239 error => 4, err => 4, die => 4,
158 warn => 5, warning => 5, 240 warn => 5, warning => 5,
159 note => 6, notice => 6, 241 note => 6, notice => 6,
160 info => 7, 242 info => 7,
161 debug => 8, 243 debug => 8,
162 trace => 9, 244 trace => 9,
163); 245);
164 246
165sub now () { time } 247our $TIME_EXACT;
248
249sub exact_time($) {
250 $TIME_EXACT = shift;
251 *_ts = $AnyEvent::MODEL
252 ? $TIME_EXACT ? \&AE::now : \&AE::time
253 : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
254}
255
256BEGIN {
257 exact_time 0;
258}
166 259
167AnyEvent::post_detect { 260AnyEvent::post_detect {
168 *now = \&AE::now; 261 exact_time $TIME_EXACT;
169}; 262};
170 263
171our @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);
172 265
173# time, ctx, level, msg 266# time, ctx, level, msg
183 } 276 }
184 277
185 join "", @res 278 join "", @res
186} 279}
187 280
281sub fatal_exit() {
282 exit 1;
283}
284
188sub _log { 285sub _log {
189 my ($ctx, $level, $format, @args) = @_; 286 my ($ctx, $level, $format, @args) = @_;
190 287
191 $level = $level > 0 && $level <= 9 288 $level = $level > 0 && $level <= 9
192 ? $level+0 289 ? $level+0
193 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 290 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
194 291
195 my $mask = 1 << $level; 292 my $mask = 1 << $level;
196 293
197 my (%seen, @ctx, $now, $fmt); 294 my ($success, %seen, @ctx, $now, @fmt);
198 295
199 do 296 do
200 { 297 {
201 # skip if masked 298 # if !ref, then it's a level number
299 if (!ref $ctx) {
300 $level = $ctx;
202 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
203 if ($ctx->[3]) { 311 if ($ctx->[3]) {
204 # logging target found 312 # logging target found
313
314 local ($!, $@);
205 315
206 # now get raw message, unless we have it already 316 # now get raw message, unless we have it already
207 unless ($now) { 317 unless ($now) {
208 $format = $format->() if ref $format; 318 $format = $format->() if ref $format;
209 $format = sprintf $format, @args if @args; 319 $format = sprintf $format, @args if @args;
210 $format =~ s/\n$//; 320 $format =~ s/\n$//;
211 $now = AE::now; 321 $now = _ts;
212 }; 322 };
213 323
214 # format msg 324 # format msg
215 my $str = $ctx->[4] 325 my $str = $ctx->[4]
216 ? $ctx->[4]($now, $_[0], $level, $format) 326 ? $ctx->[4]($now, $_[0], $level, $format)
217 : $fmt ||= _format $now, $_[0], $level, $format; 327 : ($fmt[$level] ||= _format $now, $_[0], $level, $format);
218 328
329 $success = 1;
330
219 $ctx->[3]($str); 331 $ctx->[3]($str)
332 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
333 } else {
334 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
220 } 335 }
221
222 # not masked, not consumed - propagate to parent contexts
223 push @ctx, values %{ $ctx->[2] };
224 } 336 }
225 } 337 }
226 while $ctx = pop @ctx; 338 while $ctx = pop @ctx;
227 339
228 exit 1 if $level <= 1; 340 fatal_exit if $level <= 1;
341
342 $success
229} 343}
230 344
231sub log($$;@) { 345sub log($$;@) {
232 _log 346 _log
233 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 347 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
234 @_; 348 @_;
235} 349}
236 350
237*AnyEvent::log = *AE::log = \&log;
238
239=item $logger = AnyEvent::Log::logger $level[, \$enabled] 351=item $logger = AnyEvent::Log::logger $level[, \$enabled]
240 352
241Creates a code reference that, when called, acts as if the 353Creates a code reference that, when called, acts as if the
242C<AnyEvent::Log::log> function was called at this point with the givne 354C<AnyEvent::Log::log> function was called at this point with the given
243level. 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
244the C<AnyEvent::Log::log> function: 356the C<AnyEvent::Log::log> function:
245 357
246 my $debug_log = AnyEvent::Log::logger "debug"; 358 my $debug_log = AnyEvent::Log::logger "debug";
247 359
307 419
308 $LOGGER{$logger+0} = $logger; 420 $LOGGER{$logger+0} = $logger;
309 421
310 _reassess $logger+0; 422 _reassess $logger+0;
311 423
424 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
312 my $guard = AnyEvent::Util::guard { 425 my $guard = AnyEvent::Util::guard (sub {
313 # "clean up" 426 # "clean up"
314 delete $LOGGER{$logger+0}; 427 delete $LOGGER{$logger+0};
315 }; 428 });
316 429
317 sub { 430 sub {
318 $guard if 0; # keep guard alive, but don't cause runtime overhead 431 $guard if 0; # keep guard alive, but don't cause runtime overhead
319 432
320 _log $ctx, $level, @_ 433 _log $ctx, $level, @_
325sub logger($;$) { 438sub logger($;$) {
326 _logger 439 _logger
327 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 440 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
328 @_ 441 @_
329} 442}
443
444=item AnyEvent::Log::exact_time $on
445
446By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
447eventloop time, for the log timestamps. After calling this function with a
448true value it will instead resort to C<AE::time>, i.e. fetch the current
449time on each log message. This only makes a difference for event loops
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.
453
454Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
455initialised, this switch will also decide whether to use C<CORE::time> or
456C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
457available.
330 458
331=back 459=back
332 460
333=head1 LOGGING CONTEXTS 461=head1 LOGGING CONTEXTS
334 462
347timestamp, context, level and string message and formats it in the way 475timestamp, context, level and string message and formats it in the way
348it should be logged) and a logging callback (which is responsible for 476it should be logged) and a logging callback (which is responsible for
349actually logging the formatted message and telling C<AnyEvent::Log> 477actually logging the formatted message and telling C<AnyEvent::Log>
350whether it has consumed the message, or whether it should be propagated). 478whether it has consumed the message, or whether it should be propagated).
351 479
352For propagation, a context can have any number of attached I<parent 480For propagation, a context can have any number of attached I<slave
353contexts>. Any message that is neither masked by the logging mask nor 481contexts>. Any message that is neither masked by the logging mask nor
354masked by the logging callback returning true will be passed to all parent 482masked by the logging callback returning true will be passed to all slave
355contexts. 483contexts.
356 484
357Each call to a logging function will log the message at most once per 485Each call to a logging function will log the message at most once per
358context, so it does not matter (much) if there are cycles or if the 486context, so it does not matter (much) if there are cycles or if the
359message can arrive at the same context via multiple paths. 487message can arrive at the same context via multiple paths.
363By default, all logging contexts have an full set of log levels ("all"), a 491By default, all logging contexts have an full set of log levels ("all"), a
364disabled logging callback and the default formatting callback. 492disabled logging callback and the default formatting callback.
365 493
366Package contexts have the package name as logging title by default. 494Package contexts have the package name as logging title by default.
367 495
368They have exactly one parent - the context of the "parent" package. The 496They have exactly one slave - the context of the "parent" package. The
369parent package is simply defined to be the package name without the last 497parent package is simply defined to be the package name without the last
370component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>, 498component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
371and C<AnyEvent> becomes ... C<AnyEvent::Log::Top> which is the 499and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
372exception of the rule - just like the parent of any package name in 500exception of the rule - just like the "parent" of any single-component
373Perl is C<main>, the default parent of any top-level package context is 501package name in Perl is C<main>, the default slave of any top-level
374C<AnyEvent::Log::Top>. 502package context is C<$AnyEvent::Log::COLLECT>.
375 503
376Since perl packages form only an approximate hierarchy, this parent 504Since perl packages form only an approximate hierarchy, this slave
377context can of course be removed. 505context can of course be removed.
378 506
379All other (anonymous) contexts have no parents and an empty title by 507All other (anonymous) contexts have no slaves and an empty title by
380default. 508default.
381 509
382When the module is loaded it creates the default context called 510When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
383C<AnyEvent::Log::Default> (also stored in C<$AnyEvent::Log::Default>), 511context that simply logs everything via C<warn>, without propagating
384which simply logs everything via C<warn> and doesn't propagate anything
385anywhere by default. The purpose of the default context is to provide 512anything anywhere by default. The purpose of this context is to provide
386a convenient place to override the global logging target or to attach 513a convenient place to override the global logging target or to attach
387additional log targets. It's not meant for filtering. 514additional log targets. It's not meant for filtering.
388 515
389It then creates the root context called C<AnyEvent::Log::Root> (also 516It then creates the C<$AnyEvent::Log::FILTER> context whose
390stored in C<$AnyEvent::Log::Root>) and sets its log level set to all 517purpose is to suppress all messages with priority higher
391levels up to the one specified by C<$ENV{PERL_ANYEVENT_VERBOSE}>. It 518than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
392then attached the default logging context to it. The purpose of the root 519C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
393context is to simply provide filtering according to some global log level. 520is to simply provide filtering according to some global log level.
394 521
395Finally it creates the top-level package context called 522Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
396C<AnyEvent::Log::Top> (also stored in, you might have guessed, 523and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
397C<$AnyEvent::Log::Top>) and attached the root context but otherwise leaves
398it at default config. It's purpose is simply to collect all log messages 524leaves it at default config. Its purpose is simply to collect all log
399system-wide. 525messages system-wide.
400 526
401These three special contexts can also be referred to by the 527The hierarchy is then:
402package/context names C<AE::Log::Default>, C<AE::Log::Root> and
403C<AE::Log::Top>.
404 528
529 any package, eventually -> $COLLECT -> $FILTER -> $LOG
530
405The effect of all this is that log messages, by default, wander up 531The effect of all this is that log messages, by default, wander up to the
406to the root context where log messages with lower priority then 532C<$AnyEvent::Log::COLLECT> context where all messages normally end up,
533from there to C<$AnyEvent::Log::FILTER> where log messages with lower
407C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered away and then to the 534priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
408AnyEvent::Log::Default context to be passed to C<warn>. 535to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
409 536
410Splitting the top level context into three contexts makes it easy to set 537This makes it easy to set a global logging level (by modifying $FILTER),
411a global logging level (by modifying the root context), but still allow 538but still allow other contexts to send, for example, their debug and trace
412other contexts to log, for example, their debug and trace messages to the
413default target despite the global logging level, or to attach additional 539messages to the $LOG target despite the global logging level, or to attach
414log targets that log messages, regardless of the global logging level. 540additional log targets that log messages, regardless of the global logging
541level.
415 542
416It also makes it easy to replace the default warn-logger by something that 543It also makes it easy to modify the default warn-logger ($LOG) to
417logs to a file, or to attach additional logging targets. 544something that logs to a file, or to attach additional logging targets
545(such as loggign to a file) by attaching it to $FILTER.
418 546
419=head2 CREATING/FINDING/DESTROYING CONTEXTS 547=head2 CREATING/FINDING/DESTROYING CONTEXTS
420 548
421=over 4 549=over 4
422 550
454This 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
455configuration, reset all contexts. 583configuration, reset all contexts.
456 584
457=cut 585=cut
458 586
587our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
588$AnyEvent::VERBOSE = 9;
589
459sub reset { 590sub reset {
460 # hard to kill complex data structures 591 # hard to kill complex data structures
461 # we recreate all package loggers and reset the hierarchy 592 # we "recreate" all package loggers and reset the hierarchy
462 while (my ($k, $v) = each %CTX) { 593 while (my ($k, $v) = each %CTX) {
463 @$v = ($k, (1 << 10) - 1 - 1, { }); 594 @$v = ($k, (1 << 10) - 1 - 1, { });
464 595
465 my $pkg = $k =~ /^(.+)::/ ? $1 : "AE::Log::Top"; 596 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
466 $v->attach ($CTX{$pkg});
467 } 597 }
468 598
469 $AnyEvent::Log::Default->parents; 599 @$_ = ($_->[0], (1 << 10) - 1 - 1)
470 $AnyEvent::Log::Default->title ("AnyEvent::Log::Default"); 600 for $LOG, $FILTER, $COLLECT;
471 $AnyEvent::Log::Default->log_cb (sub {
472 warn shift;
473 0
474 });
475 $CTX{"AnyEvent::Log::Default"} = $CTX{"AE::Log::Default"} = $AnyEvent::Log::Default;
476 601
477 $AnyEvent::Log::Root->parents ($AnyEvent::Log::Default); 602 #$LOG->slaves;
478 $AnyEvent::Log::Root->title ("AnyEvent::Log::Root"); 603 $LOG->title ('$AnyEvent::Log::LOG');
479 $AnyEvent::Log::Root->level ($AnyEvent::VERBOSE); 604 $LOG->log_to_warn;
480 $CTX{"AnyEvent::Log::Root"} = $CTX{"AE::Log::Root"} = $AnyEvent::Log::Root;
481 605
482 $AnyEvent::Log::Top->parents ($AnyEvent::Log::Root); 606 $FILTER->slaves ($LOG);
483 $AnyEvent::Log::Top->title ("AnyEvent::Log::Top"); 607 $FILTER->title ('$AnyEvent::Log::FILTER');
484 $CTX{"AnyEvent::Log::Top"} = $CTX{"AE::Log::Top"} = $AnyEvent::Log::Top; 608 $FILTER->level ($ORIG_VERBOSE);
609
610 $COLLECT->slaves ($FILTER);
611 $COLLECT->title ('$AnyEvent::Log::COLLECT');
485 612
486 _reassess; 613 _reassess;
487} 614}
488 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;
623
489# create the default logger contexts 624# create the default logger contexts
490$AnyEvent::Log::Default = ctx undef; 625$LOG = ctx undef;
491$AnyEvent::Log::Root = ctx undef; 626$FILTER = ctx undef;
492$AnyEvent::Log::Top = ctx undef; 627$COLLECT = ctx undef;
493 628
494AnyEvent::Log::reset; 629AnyEvent::Log::reset;
495 630
496# hello, CPAN, please catch me 631# hello, CPAN, please catch me
497package AnyEvent::Log::Default;
498package AE::Log::Default;
499package AnyEvent::Log::Root;
500package AE::Log::Root;
501package AnyEvent::Log::Top; 632package AnyEvent::Log::LOG;
502package AE::Log::Top; 633package AE::Log::LOG;
634package AnyEvent::Log::FILTER;
635package AE::Log::FILTER;
636package AnyEvent::Log::COLLECT;
637package AE::Log::COLLECT;
503 638
504package AnyEvent::Log::Ctx; 639package AnyEvent::Log::Ctx;
505
506# 0 1 2 3 4
507# [$title, $level, %$parents, &$logcb, &$fmtcb]
508 640
509=item $ctx = new AnyEvent::Log::Ctx methodname => param... 641=item $ctx = new AnyEvent::Log::Ctx methodname => param...
510 642
511This is a convenience constructor that makes it simpler to construct 643This is a convenience constructor that makes it simpler to construct
512anonymous logging contexts. 644anonymous logging contexts.
515name as the key with the value as parameter, unless the value is an 647name as the key with the value as parameter, unless the value is an
516arrayref, in which case it calls the method with the contents of the 648arrayref, in which case it calls the method with the contents of the
517array. The methods are called in the same order as specified. 649array. The methods are called in the same order as specified.
518 650
519Example: create a new logging context and set both the default logging 651Example: create a new logging context and set both the default logging
520level, some parent contexts and a logging callback. 652level, some slave contexts and a logging callback.
521 653
522 $ctx = new AnyEvent::Log::Ctx 654 $ctx = new AnyEvent::Log::Ctx
523 title => "dubious messages", 655 title => "dubious messages",
524 level => "error", 656 level => "error",
525 log_cb => sub { print STDOUT shift; 0 }, 657 log_cb => sub { print STDOUT shift; 0 },
526 parents => [$ctx1, $ctx, $ctx2], 658 slaves => [$ctx1, $ctx, $ctx2],
527 ; 659 ;
528 660
529=back 661=back
530 662
531=cut 663=cut
599Enables logging for the given levels, leaving all others unchanged. 731Enables logging for the given levels, leaving all others unchanged.
600 732
601=item $ctx->disable ($level[, $level...]) 733=item $ctx->disable ($level[, $level...])
602 734
603Disables logging for the given levels, leaving all others unchanged. 735Disables logging for the given levels, leaving all others unchanged.
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>.
604 758
605=cut 759=cut
606 760
607sub _lvl_lst { 761sub _lvl_lst {
608 map { 762 map {
610 : $_ eq "all" ? (1 .. 9) 764 : $_ eq "all" ? (1 .. 9)
611 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 765 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
612 } @_ 766 } @_
613} 767}
614 768
769sub _lvl {
770 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
771}
772
615our $NOP_CB = sub { 0 }; 773our $NOP_CB = sub { 0 };
616 774
617sub levels { 775sub levels {
618 my $ctx = shift; 776 my $ctx = shift;
619 $ctx->[1] = 0; 777 $ctx->[1] = 0;
622 AnyEvent::Log::_reassess; 780 AnyEvent::Log::_reassess;
623} 781}
624 782
625sub level { 783sub level {
626 my $ctx = shift; 784 my $ctx = shift;
627 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
628
629 $ctx->[1] = ((1 << $lvl) - 1) << 1; 785 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
630 AnyEvent::Log::_reassess; 786 AnyEvent::Log::_reassess;
631} 787}
632 788
633sub enable { 789sub enable {
634 my $ctx = shift; 790 my $ctx = shift;
642 $ctx->[1] &= ~(1 << $_) 798 $ctx->[1] &= ~(1 << $_)
643 for &_lvl_lst; 799 for &_lvl_lst;
644 AnyEvent::Log::_reassess; 800 AnyEvent::Log::_reassess;
645} 801}
646 802
803sub cap {
804 my $ctx = shift;
805 $ctx->[5] = &_lvl;
806}
807
647=back 808=back
648 809
649=head3 PARENT CONTEXTS 810=head3 SLAVE CONTEXTS
650 811
651The following methods attach and detach another logging context to a 812The following methods attach and detach another logging context to a
652logging context. 813logging context.
653 814
654Log messages are propagated to all parent contexts, unless the logging 815Log messages are propagated to all slave contexts, unless the logging
655callback consumes the message. 816callback consumes the message.
656 817
657=over 4 818=over 4
658 819
659=item $ctx->attach ($ctx2[, $ctx3...]) 820=item $ctx->attach ($ctx2[, $ctx3...])
660 821
661Attaches the given contexts as parents to this context. It is not an error 822Attaches the given contexts as slaves to this context. It is not an error
662to add a context twice (the second add will be ignored). 823to add a context twice (the second add will be ignored).
663 824
664A context can be specified either as package name or as a context object. 825A context can be specified either as package name or as a context object.
665 826
666=item $ctx->detach ($ctx2[, $ctx3...]) 827=item $ctx->detach ($ctx2[, $ctx3...])
667 828
668Removes the given parents from this context - it's not an error to attempt 829Removes the given slaves from this context - it's not an error to attempt
669to remove a context that hasn't been added. 830to remove a context that hasn't been added.
670 831
671A context can be specified either as package name or as a context object. 832A context can be specified either as package name or as a context object.
672 833
673=item $ctx->parents ($ctx2[, $ctx3...]) 834=item $ctx->slaves ($ctx2[, $ctx3...])
674 835
675Replaces all parents attached to this context by the ones given. 836Replaces all slaves attached to this context by the ones given.
676 837
677=cut 838=cut
678 839
679sub attach { 840sub attach {
680 my $ctx = shift; 841 my $ctx = shift;
688 849
689 delete $ctx->[2]{$_+0} 850 delete $ctx->[2]{$_+0}
690 for map { AnyEvent::Log::ctx $_ } @_; 851 for map { AnyEvent::Log::ctx $_ } @_;
691} 852}
692 853
693sub parents { 854sub slaves {
694 undef $_[0][2]; 855 undef $_[0][2];
695 &attach; 856 &attach;
696} 857}
697 858
698=back 859=back
699 860
700=head3 MESSAGE LOGGING 861=head3 LOG TARGETS
701 862
702The following methods configure how the logging context actually does 863The following methods configure how the logging context actually does
703the logging (which consists of formatting the message and printing it or 864the logging (which consists of formatting the message and printing it or
704whatever it wants to do with it) and also allows you to log messages 865whatever it wants to do with it).
705directly to a context, without going via your package context.
706 866
707=over 4 867=over 4
708 868
709=item $ctx->log_cb ($cb->($str)) 869=item $ctx->log_cb ($cb->($str))
710 870
715(see C<fmt_cb> below) - normally simple text strings that end with a 875(see C<fmt_cb> below) - normally simple text strings that end with a
716newline (and are possibly multiline themselves). 876newline (and are possibly multiline themselves).
717 877
718It also has to return true iff it has consumed the log message, and false 878It also has to return true iff it has consumed the log message, and false
719if it hasn't. Consuming a message means that it will not be sent to any 879if it hasn't. Consuming a message means that it will not be sent to any
720parent context. When in doubt, return C<0> from your logging callback. 880slave context. When in doubt, return C<0> from your logging callback.
721 881
722Example: a very simple logging callback, simply dump the message to STDOUT 882Example: a very simple logging callback, simply dump the message to STDOUT
723and do not consume it. 883and do not consume it.
724 884
725 $ctx->log_cb (sub { print STDERR shift; 0 }); 885 $ctx->log_cb (sub { print STDERR shift; 0 });
733your program. 893your program.
734 894
735 $ctx->levels ("debug", "trace"); 895 $ctx->levels ("debug", "trace");
736 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages 896 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
737 897
738=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message)) 898=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
739 899
740Replaces the formatting callback on the context (C<undef> restores the 900Replaces the formatting callback on the context (C<undef> restores the
741default formatter). 901default formatter).
742 902
743The callback is passed the (possibly fractional) timestamp, the original 903The callback is passed the (possibly fractional) timestamp, the original
744logging context, the (numeric) logging level and the raw message string and needs to 904logging context (object, not title), the (numeric) logging level and
745return a formatted log message. In most cases this will be a string, but 905the raw message string and needs to return a formatted log message. In
746it could just as well be an array reference that just stores the values. 906most cases this will be a string, but it could just as well be an array
907reference that just stores the values.
908
909If, for some reason, you want to use C<caller> to find out more about the
910logger then you should walk up the call stack until you are no longer
911inside the C<AnyEvent::Log> package.
747 912
748Example: format just the raw message, with numeric log level in angle 913Example: format just the raw message, with numeric log level in angle
749brackets. 914brackets.
750 915
751 $ctx->fmt_cb (sub { 916 $ctx->fmt_cb (sub {
753 918
754 "<$lvl>$msg\n" 919 "<$lvl>$msg\n"
755 }); 920 });
756 921
757Example: return an array reference with just the log values, and use 922Example: return an array reference with just the log values, and use
758C<PApp::SQL::sql_exec> to store the emssage in a database. 923C<PApp::SQL::sql_exec> to store the message in a database.
759 924
760 $ctx->fmt_cb (sub { \@_ }); 925 $ctx->fmt_cb (sub { \@_ });
761 $ctx->log_cb (sub { 926 $ctx->log_cb (sub {
762 my ($msg) = @_; 927 my ($msg) = @_;
763 928
768 "$msg->[3]"; 933 "$msg->[3]";
769 934
770 0 935 0
771 }); 936 });
772 937
938=item $ctx->log_to_warn
939
940Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
941(usually this logs to STDERR).
942
943=item $ctx->log_to_file ($path)
944
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.
947
948=item $ctx->log_to_path ($path)
949
950Same as C<< ->log_to_file >>, but opens the file for each message. This
951is much slower, but allows you to change/move/rename/delete the file at
952basically any time.
953
954Needless(?) to say, if you do not want to be bitten by some evil person
955calling C<chdir>, the path should be absolute. Doesn't help with
956C<chroot>, but hey...
957
958=item $ctx->log_to_syslog ([$facility])
959
960Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
961all the others in the obvious way. If specified, then the C<$facility> is
962used as the facility (C<user>, C<auth>, C<local0> and so on). The default
963facility is C<user>.
964
965Note that this function also sets a C<fmt_cb> - the logging part requires
966an array reference with [$level, $str] as input.
967
773=cut 968=cut
774 969
775sub log_cb { 970sub log_cb {
776 my ($ctx, $cb) = @_; 971 my ($ctx, $cb) = @_;
777 972
782 my ($ctx, $cb) = @_; 977 my ($ctx, $cb) = @_;
783 978
784 $ctx->[4] = $cb; 979 $ctx->[4] = $cb;
785} 980}
786 981
982sub log_to_warn {
983 my ($ctx, $path) = @_;
984
985 $ctx->log_cb (sub {
986 warn shift;
987 0
988 });
989}
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::ae_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::ae_close ($fh, sub {
1032 undef $fh;
1033 $kick->($kick);
1034 });
1035 }
1036 };
1037 };
1038
1039 if ($fh) {
1040 $write->();
1041 } else {
1042 AnyEvent::IO::ae_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
1075sub log_to_file {
1076 my ($ctx, $path) = @_;
1077
1078 _log_to_disk $ctx, $path, 1;
1079}
1080
1081sub log_to_path {
1082 my ($ctx, $path) = @_;
1083
1084 _log_to_disk $ctx, $path, 0;
1085}
1086
1087sub log_to_syslog {
1088 my ($ctx, $facility) = @_;
1089
1090 require Sys::Syslog;
1091
1092 $ctx->fmt_cb (sub {
1093 my $str = $_[3];
1094 $str =~ s/\n(?=.)/\n+ /g;
1095
1096 [$_[2], "($_[1][0]) $str"]
1097 });
1098
1099 $facility ||= "user";
1100
1101 $ctx->log_cb (sub {
1102 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
1103
1104 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
1105 for split /\n/, $_[0][1];
1106
1107 0
1108 });
1109}
1110
1111=back
1112
1113=head3 MESSAGE LOGGING
1114
1115These methods allow you to log messages directly to a context, without
1116going via your package context.
1117
1118=over 4
1119
787=item $ctx->log ($level, $msg[, @params]) 1120=item $ctx->log ($level, $msg[, @params])
788 1121
789Same 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");
790 1127
791=item $logger = $ctx->logger ($level[, \$enabled]) 1128=item $logger = $ctx->logger ($level[, \$enabled])
792 1129
793Same 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
794context. 1131context.
796=cut 1133=cut
797 1134
798*log = \&AnyEvent::Log::_log; 1135*log = \&AnyEvent::Log::_log;
799*logger = \&AnyEvent::Log::_logger; 1136*logger = \&AnyEvent::Log::_logger;
800 1137
8011;
802
803=back 1138=back
804 1139
1140=cut
1141
1142package AnyEvent::Log;
1143
1144=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
1145
1146Logging can also be configured by setting the environment variable
1147C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
1148
1149The value consists of one or more logging context specifications separated
1150by C<:> or whitespace. Each logging specification in turn starts with a
1151context name, followed by C<=>, followed by zero or more comma-separated
1152configuration directives, here are some examples:
1153
1154 # set default logging level
1155 filter=warn
1156
1157 # log to file instead of to stderr
1158 log=file=/tmp/mylog
1159
1160 # log to file in addition to stderr
1161 log=+%file:%file=file=/tmp/mylog
1162
1163 # enable debug log messages, log warnings and above to syslog
1164 filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
1165
1166 # log trace messages (only) from AnyEvent::Debug to file
1167 AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
1168
1169A context name in the log specification can be any of the following:
1170
1171=over 4
1172
1173=item C<collect>, C<filter>, C<log>
1174
1175Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
1176C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
1177
1178=item C<%name>
1179
1180Context names starting with a C<%> are anonymous contexts created when the
1181name is first mentioned. The difference to package contexts is that by
1182default they have no attached slaves.
1183
1184=item a perl package name
1185
1186Any other string references the logging context associated with the given
1187Perl C<package>. In the unlikely case where you want to specify a package
1188context that matches on of the other context name forms, you can add a
1189C<::> to the package name to force interpretation as a package.
1190
1191=back
1192
1193The configuration specifications can be any number of the following:
1194
1195=over 4
1196
1197=item C<stderr>
1198
1199Configures the context to use Perl's C<warn> function (which typically
1200logs to C<STDERR>). Works like C<log_to_warn>.
1201
1202=item C<file=>I<path>
1203
1204Configures the context to log to a file with the given path. Works like
1205C<log_to_file>.
1206
1207=item C<path=>I<path>
1208
1209Configures the context to log to a file with the given path. Works like
1210C<log_to_path>.
1211
1212=item C<syslog> or C<syslog=>I<expr>
1213
1214Configures the context to log to syslog. If I<expr> is given, then it is
1215evaluated in the L<Sys::Syslog> package, so you could use:
1216
1217 log=syslog=LOG_LOCAL0
1218
1219=item C<nolog>
1220
1221Configures the context to not log anything by itself, which is the
1222default. Same as C<< $ctx->log_cb (undef) >>.
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
1230=item C<0> or C<off>
1231
1232Sets the logging level of the context to C<0>, i.e. all messages will be
1233filtered out.
1234
1235=item C<all>
1236
1237Enables all logging levels, i.e. filtering will effectively be switched
1238off (the default).
1239
1240=item C<only>
1241
1242Disables all logging levels, and changes the interpretation of following
1243level specifications to enable the specified level only.
1244
1245Example: only enable debug messages for a context.
1246
1247 context=only,debug
1248
1249=item C<except>
1250
1251Enables all logging levels, and changes the interpretation of following
1252level specifications to disable that level. Rarely used.
1253
1254Example: enable all logging levels except fatal and trace (this is rather
1255nonsensical).
1256
1257 filter=exept,fatal,trace
1258
1259=item C<level>
1260
1261Enables all logging levels, and changes the interpretation of following
1262level specifications to be "that level or any higher priority
1263message". This is the default.
1264
1265Example: log anything at or above warn level.
1266
1267 filter=warn
1268
1269 # or, more verbose
1270 filter=only,level,warn
1271
1272=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
1273
1274A numeric loglevel or the name of a loglevel will be interpreted according
1275to the most recent C<only>, C<except> or C<level> directive. By default,
1276specifying a logging level enables that and any higher priority messages.
1277
1278=item C<+>I<context>
1279
1280Attaches the named context as slave to the context.
1281
1282=item C<+>
1283
1284A lone C<+> detaches all contexts, i.e. clears the slave list from the
1285context. Anonymous (C<%name>) contexts have no attached slaves by default,
1286but package contexts have the parent context as slave by default.
1287
1288Example: log messages from My::Module to a file, do not send them to the
1289default log collector.
1290
1291 My::Module=+,file=/tmp/mymodulelog
1292
1293=back
1294
1295Any character can be escaped by prefixing it with a C<\> (backslash), as
1296usual, so to log to a file containing a comma, colon, backslash and some
1297spaces in the filename, you would do this:
1298
1299 PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
1300
1301Since whitespace (which includes newlines) is allowed, it is fine to
1302specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
1303
1304 PERL_ANYEVENT_LOG="
1305 filter=warn
1306 AnyEvent::Debug=+%trace
1307 %trace=only,trace,+log
1308 " myprog
1309
1310Also, in the unlikely case when you want to concatenate specifications,
1311use whitespace as separator, as C<::> will be interpreted as part of a
1312module name, an empty spec with two separators:
1313
1314 PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
1315
1316=cut
1317
1318for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1319 my %anon;
1320
1321 my $pkg = sub {
1322 $_[0] eq "log" ? $LOG
1323 : $_[0] eq "filter" ? $FILTER
1324 : $_[0] eq "collect" ? $COLLECT
1325 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1326 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1327 : die # never reached?
1328 };
1329
1330 /\G[[:space:]]+/gc; # skip initial whitespace
1331
1332 while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
1333 my $ctx = $pkg->($1);
1334 my $level = "level";
1335
1336 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1337 for ("$1") {
1338 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1339 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1340 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1341 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1342 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1343 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1344 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1345 } elsif ($_ eq "+" ) { $ctx->slaves;
1346 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1347 } elsif ($_ eq "all" ) { $ctx->level ("all");
1348 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1349 } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
1350 } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
1351 } elsif (/^\d$/ ) { $ctx->$level ($_);
1352 } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
1353 } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
1354 }
1355 }
1356
1357 /\G,/gc or last;
1358 }
1359
1360 /\G[:[:space:]]+/gc or last;
1361 }
1362
1363 /\G[[:space:]]+/gc; # skip trailing whitespace
1364
1365 if (/\G(.+)/g) {
1366 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1367 }
1368}
1369
805=head1 EXAMPLES 1370=head1 EXAMPLES
806 1371
807This section shows some common configurations. 1372This section shows some common configurations, both as code, and as
1373C<PERL_ANYEVENT_LOG> string.
808 1374
809=over 4 1375=over 4
810 1376
811=item Setting the global logging level. 1377=item Setting the global logging level.
812 1378
813Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before 1379Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
814running your program, or modify the log level of the root context: 1380running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
1381the root context at runtime:
815 1382
816 PERL_ANYEVENT_VERBOSE=5 ./myprog 1383 PERL_ANYEVENT_VERBOSE=5 ./myprog
817 1384
1385 PERL_ANYEVENT_LOG=log=warn
1386
818 $AnyEvent::Log::Root->level ("warn"); 1387 $AnyEvent::Log::FILTER->level ("warn");
819 1388
820=item Append all messages to a file instead of sending them to STDERR. 1389=item Append all messages to a file instead of sending them to STDERR.
821 1390
822This is affected by the global logging level. 1391This is affected by the global logging level.
823 1392
824 open my $fh, ">>", $path 1393 $AnyEvent::Log::LOG->log_to_file ($path);
825 or die "$path: $!";
826 1394
827 $AnyEvent::Log::Default->log_cb (sub { 1395 PERL_ANYEVENT_LOG=log=file=/some/path
828 syswrite $fh, shift;
829 0
830 });
831 1396
832=item Write all messages with priority C<error> and higher to a file. 1397=item Write all messages with priority C<error> and higher to a file.
833 1398
834This writes them only when the global logging level allows it, because 1399This writes them only when the global logging level allows it, because
835it 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
836filtering. 1401filtering.
837 1402
838 open my $fh, ">>", $path 1403 $AnyEvent::Log::FILTER->attach (
839 or die "$path: $!"; 1404 new AnyEvent::Log::Ctx log_to_file => $path);
840 1405
841 $AnyEvent::Log::Default->attach (new AnyEvent::Log::Ctx 1406 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
842 log_cb => sub { syswrite $fh, shift; 0 });
843 1407
844This writes them regardless of the global logging level, because it is 1408This writes them regardless of the global logging level, because it is
845attached to the toplevel context, which receives all messages I<before> 1409attached to the toplevel context, which receives all messages I<before>
846the global filtering. 1410the global filtering.
847 1411
848 $AnyEvent::Log::Top->attach (new AnyEvent::Log::Ctx 1412 $AnyEvent::Log::COLLECT->attach (
849 log_cb => sub { syswrite $fh, shift; 0 }); 1413 new AnyEvent::Log::Ctx log_to_file => $path);
850 1414
1415 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1416
851In both cases, messages are still written to STDOUT. 1417In both cases, messages are still written to STDERR.
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
852 1435
853=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).
854 1437
855Attach the CyAnyEvent::Log::Default> context to the C<AnyEvent::Debug> 1438Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
856context and increase the C<AnyEvent::Debug> logging level - this simply
857circumvents the global filtering for trace messages. 1439context - this simply circumvents the global filtering for trace messages.
858 1440
859 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx; 1441 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
860 $debug->attach ($AnyEvent::Log::Default); 1442 $debug->attach ($AnyEvent::Log::LOG);
861 $debug->levels ("trace"); # not "level"!
862 1443
863This of course works for any package. 1444 PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
1445
1446This of course works for any package, not just L<AnyEvent::Debug>, but
1447assumes the log level for AnyEvent::Debug hasn't been changed from the
1448default.
864 1449
865=back 1450=back
866 1451
867=head1 AUTHOR 1452=head1 AUTHOR
868 1453
869 Marc Lehmann <schmorp@schmorp.de> 1454 Marc Lehmann <schmorp@schmorp.de>
870 http://home.schmorp.de/ 1455 http://home.schmorp.de/
871 1456
872=cut 1457=cut
1458
14591
1460

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines