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.10 by root, Fri Aug 19 21:17:08 2011 UTC vs.
Revision 1.46 by root, Sun Oct 2 01:22:01 2011 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 trace => "going to call function abc";
11 AE::log warn => "it's a bit too hot"; 12 AE::log debug => "the function returned 3";
12 AE::log error => "the flag was false!"; 13 AE::log info => "file soandso successfully deleted";
13 AE::log fatal => "the bit toggled! run!"; 14 AE::log note => "wanted to create config, but config was alraedy created";
15 AE::log warn => "couldn't delete the file";
16 AE::log error => "failed to retrieve data";
17 AE::log crit => "the battery temperature is too hot";
18 AE::log alert => "the battery died";
19 AE::log fatal => "no config found, cannot continue"; # never returns
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 maximum 45 # set logging for the current package to errors and higher only
26 AnyEvent::Log::ctx->level ("all"); 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::ctx "")->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,
32 52 # regardless of (most) other settings
33 # disable logging for package "AnyEvent" and all packages below it 53 $AnyEvent::Log::COLLECT->attach (new AnyEvent::Log::Ctx
34 AnyEvent->AnyEvent::Log::ctx->level (0); 54 level => "critical",
35 55 log_to_syslog => "user",
36 # log everything below debug to a file, for the whole program 56 );
37 my $ctx = AnyEvent::Log::ctx;
38 $ctx->log_cb (sub { print FILE shift; 0 });
39 (AnyEvent::Log::ctx "")->add ($ctx);
40 57
41=head1 DESCRIPTION 58=head1 DESCRIPTION
42 59
43This module implements a relatively simple "logging framework". It doesn't 60This module implements a relatively simple "logging framework". It doesn't
44attempt to be "the" logging solution or even "a" logging solution for 61attempt to be "the" logging solution or even "a" logging solution for
45AnyEvent - AnyEvent simply creates logging messages internally, and this 62AnyEvent - AnyEvent simply creates logging messages internally, and this
46module 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
47using it from other modules as well. 64using it from other modules as well.
48 65
49Remember that the default verbosity level is C<0>, so nothing will be 66Remember that the default verbosity level is C<0> (C<off>), so nothing
50logged, ever, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number 67will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
51before starting your program, or change the logging level at runtime wiht 68before starting your program, or change the logging level at runtime with
52something like: 69something like:
53 70
54 use AnyEvent; 71 use AnyEvent::Log;
55 (AnyEvent::Log::ctx "")->level ("info"); 72 $AnyEvent::Log::FILTER->level ("info");
56 73
57The design goal behind this module was to keep it simple (and small), 74The design goal behind this module was to keep it simple (and small),
58but make it powerful enough to be potentially useful for any module, and 75but make it powerful enough to be potentially useful for any module, and
59extensive enough for the most common tasks, such as logging to multiple 76extensive enough for the most common tasks, such as logging to multiple
60targets, or being able to log into a database. 77targets, or being able to log into a database.
61 78
79The module is also usable before AnyEvent itself is initialised, in which
80case some of the functionality might be reduced.
81
82The amount of documentation might indicate otherwise, but the runtime part
83of the module is still just below 300 lines of code.
84
85=head1 LOGGING LEVELS
86
87Logging levels in this module range from C<1> (highest priority) to C<9>
88(lowest priority). Note that the lowest numerical value is the highest
89priority, so when this document says "higher priority" it means "lower
90numerical value".
91
92Instead of specifying levels by name you can also specify them by aliases:
93
94 LVL NAME SYSLOG PERL NOTE
95 1 fatal emerg exit system unusable, aborts program!
96 2 alert failure in primary system
97 3 critical crit failure in backup system
98 4 error err die non-urgent program errors, a bug
99 5 warn warning possible problem, not necessarily error
100 6 note notice unusual conditions
101 7 info normal messages, no action required
102 8 debug debugging messages for development
103 9 trace copious tracing output
104
105As you can see, some logging levels have multiple aliases - the first one
106is the "official" name, the second one the "syslog" name (if it differs)
107and the third one the "perl" name, suggesting (only!) that you log C<die>
108messages at C<error> priority. The NOTE column tries to provide some
109rationale on how to chose a logging level.
110
111As a rough guideline, levels 1..3 are primarily meant for users of
112the program (admins, staff), and are the only logged to STDERR by
113default. Levels 4..6 are meant for users and developers alike, while
114levels 7..9 are usually meant for developers.
115
116You can normally only log a single message at highest priority level
117(C<1>, C<fatal>), because logging a fatal message will also quit the
118program - so use it sparingly :)
119
120Some methods also offer some extra levels, such as C<0>, C<off>, C<none>
121or C<all> - these are only valid in the methods they are documented for.
122
62=head1 LOGGING FUNCTIONS 123=head1 LOGGING FUNCTIONS
63 124
64These functions allow you to log messages. They always use the caller's 125These functions allow you to log messages. They always use the caller's
65package as a "logging module/source". Also, the main logging function is 126package as a "logging context". Also, the main logging function C<log> is
66callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is 127callable as C<AnyEvent::log> or C<AE::log> when the C<AnyEvent> module is
67loaded. 128loaded.
68 129
69=over 4 130=over 4
70 131
73package AnyEvent::Log; 134package AnyEvent::Log;
74 135
75use Carp (); 136use Carp ();
76use POSIX (); 137use POSIX ();
77 138
139# layout of a context
140# 0 1 2 3 4, 5
141# [$title, $level, %$slaves, &$logcb, &$fmtcb, $cap]
142
78use AnyEvent (); BEGIN { AnyEvent::common_sense } 143use AnyEvent (); BEGIN { AnyEvent::common_sense }
79use AnyEvent::Util (); 144#use AnyEvent::Util (); need to load this in a delayed fashion, as it uses AE::log
145
146our $VERSION = $AnyEvent::VERSION;
147
148our ($COLLECT, $FILTER, $LOG);
80 149
81our ($now_int, $now_str1, $now_str2); 150our ($now_int, $now_str1, $now_str2);
82 151
83# Format Time, not public - yet? 152# Format Time, not public - yet?
84sub ft($) { 153sub ft($) {
89 if $now_int != $i; 158 if $now_int != $i;
90 159
91 "$now_str1$f$now_str2" 160 "$now_str1$f$now_str2"
92} 161}
93 162
94our %CTX; # all logging contexts 163our %CTX; # all package contexts
95 164
96# creates a default package context object for the given package 165# creates a default package context object for the given package
97sub _pkg_ctx($) { 166sub _pkg_ctx($) {
98 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx"; 167 my $ctx = bless [$_[0], (1 << 10) - 1 - 1, {}], "AnyEvent::Log::Ctx";
99 168
100 # link "parent" package 169 # link "parent" package
101 my $pkg = $_[0] =~ /^(.+)::/ ? $1 : ""; 170 my $parent = $_[0] =~ /^(.+)::/
171 ? $CTX{$1} ||= &_pkg_ctx ("$1")
172 : $COLLECT;
102 173
103 $pkg = $CTX{$pkg} ||= &_pkg_ctx ($pkg);
104 $ctx->[2]{$pkg+0} = $pkg; 174 $ctx->[2]{$parent+0} = $parent;
105 175
106 $ctx 176 $ctx
107} 177}
108 178
109=item AnyEvent::Log::log $level, $msg[, @args] 179=item AnyEvent::Log::log $level, $msg[, @args]
110 180
111Requests logging of the given C<$msg> with the given log level (1..9). 181Requests logging of the given C<$msg> with the given log level, and
112You can also use the following strings as log level: C<fatal> (1), 182returns true if the message was logged I<somewhere>.
113C<alert> (2), C<critical> (3), C<error> (4), C<warn> (5), C<note> (6),
114C<info> (7), C<debug> (8), C<trace> (9).
115 183
116For C<fatal> log levels, the program will abort. 184For loglevel C<fatal>, the program will abort.
117 185
118If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the 186If only a C<$msg> is given, it is logged as-is. With extra C<@args>, the
119C<$msg> is interpreted as an sprintf format string. 187C<$msg> is interpreted as an sprintf format string.
120 188
121The C<$msg> should not end with C<\n>, but may if that is convenient for 189The C<$msg> should not end with C<\n>, but may if that is convenient for
124Last not least, C<$msg> might be a code reference, in which case it is 192Last not least, C<$msg> might be a code reference, in which case it is
125supposed to return the message. It will be called only then the message 193supposed to return the message. It will be called only then the message
126actually gets logged, which is useful if it is costly to create the 194actually gets logged, which is useful if it is costly to create the
127message in the first place. 195message in the first place.
128 196
197This function takes care of saving and restoring C<$!> and C<$@>, so you
198don't have to.
199
129Whether the given message will be logged depends on the maximum log level 200Whether the given message will be logged depends on the maximum log level
130and the caller's package. 201and the caller's package. The return value can be used to ensure that
202messages or not "lost" - for example, when L<AnyEvent::Debug> detects a
203runtime error it tries to log it at C<die> level, but if that message is
204lost it simply uses warn.
131 205
132Note that you can (and should) call this function as C<AnyEvent::log> or 206Note that you can (and should) call this function as C<AnyEvent::log> or
133C<AE::log>, without C<use>-ing this module if possible (i.e. you don't 207C<AE::log>, without C<use>-ing this module if possible (i.e. you don't
134need any additional functionality), as those functions will load the 208need any additional functionality), as those functions will load the
135logging module on demand only. They are also much shorter to write. 209logging module on demand only. They are also much shorter to write.
136 210
137Also, if you otpionally generate a lot of debug messages (such as when 211Also, if you optionally generate a lot of debug messages (such as when
138tracing some code), you should look into using a logger callback and a 212tracing some code), you should look into using a logger callback and a
139boolean enabler (see C<logger>, below). 213boolean enabler (see C<logger>, below).
140 214
141Example: log something at error level. 215Example: log something at error level.
142 216
152 226
153=cut 227=cut
154 228
155# also allow syslog equivalent names 229# also allow syslog equivalent names
156our %STR2LEVEL = ( 230our %STR2LEVEL = (
157 fatal => 1, emerg => 1, 231 fatal => 1, emerg => 1, exit => 1,
158 alert => 2, 232 alert => 2,
159 critical => 3, crit => 3, 233 critical => 3, crit => 3,
160 error => 4, err => 4, 234 error => 4, err => 4, die => 4,
161 warn => 5, warning => 5, 235 warn => 5, warning => 5,
162 note => 6, notice => 6, 236 note => 6, notice => 6,
163 info => 7, 237 info => 7,
164 debug => 8, 238 debug => 8,
165 trace => 9, 239 trace => 9,
166); 240);
167 241
168sub now () { time } 242our $TIME_EXACT;
243
244sub exact_time($) {
245 $TIME_EXACT = shift;
246 *_ts = $AnyEvent::MODEL
247 ? $TIME_EXACT ? \&AE::now : \&AE::time
248 : sub () { $TIME_EXACT ? do { require Time::HiRes; Time::HiRes::time () } : time };
249}
250
251BEGIN {
252 exact_time 0;
253}
169 254
170AnyEvent::post_detect { 255AnyEvent::post_detect {
171 *now = \&AE::now; 256 exact_time $TIME_EXACT;
172}; 257};
173 258
174our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace); 259our @LEVEL2STR = qw(0 fatal alert crit error warn note info debug trace);
175 260
176# time, ctx, level, msg 261# time, ctx, level, msg
177sub _format($$$$) { 262sub _format($$$$) {
178 my $pfx = ft $_[0]; 263 my $ts = ft $_[0];
264 my $ct = " ";
265
179 my @res; 266 my @res;
180 267
181 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) { 268 for (split /\n/, sprintf "%-5s %s: %s", $LEVEL2STR[$_[2]], $_[1][0], $_[3]) {
182 push @res, "$pfx $_\n"; 269 push @res, "$ts$ct$_\n";
183 $pfx = "\t"; 270 $ct = " + ";
184 } 271 }
185 272
186 join "", @res 273 join "", @res
274}
275
276sub fatal_exit() {
277 exit 1;
187} 278}
188 279
189sub _log { 280sub _log {
190 my ($ctx, $level, $format, @args) = @_; 281 my ($ctx, $level, $format, @args) = @_;
191 282
283 $level = $level > 0 && $level <= 9
284 ? $level+0
192 $level = $level > 0 && $level <= 9 ? $level+0 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 285 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
193 286
194 my $mask = 1 << $level; 287 my $mask = 1 << $level;
195 288
196 my (@ctx, $now, $fmt); 289 my ($success, %seen, @ctx, $now, @fmt);
197 290
198 do { 291 do
199 # skip if masked 292 {
200 next unless $ctx->[1] & $mask; 293 # if !ref, then it's a level number
294 if (!ref $ctx) {
295 $level = $ctx;
296 } elsif ($ctx->[1] & $mask and !$seen{$ctx+0}++) {
297 # logging/recursing into this context
201 298
299 # level cap
300 if ($ctx->[5] > $level) {
301 push @ctx, $level; # restore level when going up in tree
302 $level = $ctx->[5];
303 }
304
305 # log if log cb
202 if ($ctx->[3]) { 306 if ($ctx->[3]) {
203 # logging target found 307 # logging target found
204 308
309 local ($!, $@);
310
205 # now get raw message, unless we have it already 311 # now get raw message, unless we have it already
206 unless ($now) { 312 unless ($now) {
207 $format = $format->() if ref $format; 313 $format = $format->() if ref $format;
208 $format = sprintf $format, @args if @args; 314 $format = sprintf $format, @args if @args;
209 $format =~ s/\n$//; 315 $format =~ s/\n$//;
210 $now = AE::now; 316 $now = _ts;
317 };
318
319 # format msg
320 my $str = $ctx->[4]
321 ? $ctx->[4]($now, $_[0], $level, $format)
322 : ($fmt[$level] ||= _format $now, $_[0], $level, $format);
323
324 $success = 1;
325
326 $ctx->[3]($str)
327 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
328 } else {
329 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
330 }
211 }; 331 }
212
213 # format msg
214 my $str = $ctx->[4]
215 ? $ctx->[4]($now, $_[0], $level, $format)
216 : $fmt ||= _format $now, $_[0], $level, $format;
217
218 $ctx->[3]($str)
219 and next;
220 } 332 }
221
222 # not masked, not consume - propagate to parent contexts
223 push @ctx, values %{ $ctx->[2] };
224 } while $ctx = pop @ctx; 333 while $ctx = pop @ctx;
225 334
226 exit 1 if $level <= 1; 335 fatal_exit if $level <= 1;
336
337 $success
227} 338}
228 339
229sub log($$;@) { 340sub log($$;@) {
230 _log 341 _log
231 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 342 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
232 @_; 343 @_;
233} 344}
234 345
235*AnyEvent::log = *AE::log = \&log;
236
237=item $logger = AnyEvent::Log::logger $level[, \$enabled] 346=item $logger = AnyEvent::Log::logger $level[, \$enabled]
238 347
239Creates a code reference that, when called, acts as if the 348Creates a code reference that, when called, acts as if the
240C<AnyEvent::Log::log> function was called at this point with the givne 349C<AnyEvent::Log::log> function was called at this point with the given
241level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with 350level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
242the C<AnyEvent::Log::log> function: 351the C<AnyEvent::Log::log> function:
243 352
244 my $debug_log = AnyEvent::Log::logger "debug"; 353 my $debug_log = AnyEvent::Log::logger "debug";
245 354
270 # and later in your program 379 # and later in your program
271 $debug_log->("yo, stuff here") if $debug; 380 $debug_log->("yo, stuff here") if $debug;
272 381
273 $debug and $debug_log->("123"); 382 $debug and $debug_log->("123");
274 383
275Note: currently the enabled var is always true - that will be fixed in a
276future version :)
277
278=cut 384=cut
279 385
280our %LOGGER; 386our %LOGGER;
281 387
282# re-assess logging status for all loggers 388# re-assess logging status for all loggers
283sub _reassess { 389sub _reassess {
390 local $SIG{__DIE__};
391 my $die = sub { die };
392
284 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) { 393 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
285 my ($ctx, $level, $renabled) = @$_; 394 my ($ctx, $level, $renabled) = @$_;
286 395
287 # to detetc whether a message would be logged, we # actually 396 # to detect whether a message would be logged, we actually
288 # try to log one and die. this isn't # fast, but we can be 397 # try to log one and die. this isn't fast, but we can be
289 # sure that the logging decision is correct :) 398 # sure that the logging decision is correct :)
290 399
291 $$renabled = !eval { 400 $$renabled = !eval {
292 local $SIG{__DIE__};
293
294 _log $ctx, $level, sub { die }; 401 _log $ctx, $level, $die;
295 402
296 1 403 1
297 }; 404 };
298
299 $$renabled = 1; # TODO
300 } 405 }
301} 406}
302 407
303sub _logger($;$) { 408sub _logger {
304 my ($ctx, $level, $renabled) = @_; 409 my ($ctx, $level, $renabled) = @_;
305 410
306 $renabled ||= \my $enabled;
307
308 $$renabled = 1; 411 $$renabled = 1;
309 412
310 my $logger = [$ctx, $level, $renabled]; 413 my $logger = [$ctx, $level, $renabled];
311 414
312 $LOGGER{$logger+0} = $logger; 415 $LOGGER{$logger+0} = $logger;
313 416
314 _reassess $logger+0; 417 _reassess $logger+0;
315 418
419 require AnyEvent::Util unless $AnyEvent::Util::VERSION;
316 my $guard = AnyEvent::Util::guard { 420 my $guard = AnyEvent::Util::guard (sub {
317 # "clean up" 421 # "clean up"
318 delete $LOGGER{$logger+0}; 422 delete $LOGGER{$logger+0};
319 }; 423 });
320 424
321 sub { 425 sub {
322 $guard if 0; # keep guard alive, but don't cause runtime overhead 426 $guard if 0; # keep guard alive, but don't cause runtime overhead
323 427
324 _log $ctx, $level, @_ 428 _log $ctx, $level, @_
329sub logger($;$) { 433sub logger($;$) {
330 _logger 434 _logger
331 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 435 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
332 @_ 436 @_
333} 437}
438
439=item AnyEvent::Log::exact_time $on
440
441By default, C<AnyEvent::Log> will use C<AE::now>, i.e. the cached
442eventloop time, for the log timestamps. After calling this function with a
443true value it will instead resort to C<AE::time>, i.e. fetch the current
444time on each log message. This only makes a difference for event loops
445that actually cache the time (such as L<EV> or L<AnyEvent::Loop>).
446
447This setting can be changed at any time by calling this function.
448
449Since C<AnyEvent::Log> has to work even before the L<AnyEvent> has been
450initialised, this switch will also decide whether to use C<CORE::time> or
451C<Time::HiRes::time> when logging a message before L<AnyEvent> becomes
452available.
334 453
335=back 454=back
336 455
337=head1 LOGGING CONTEXTS 456=head1 LOGGING CONTEXTS
338 457
351timestamp, context, level and string message and formats it in the way 470timestamp, context, level and string message and formats it in the way
352it should be logged) and a logging callback (which is responsible for 471it should be logged) and a logging callback (which is responsible for
353actually logging the formatted message and telling C<AnyEvent::Log> 472actually logging the formatted message and telling C<AnyEvent::Log>
354whether it has consumed the message, or whether it should be propagated). 473whether it has consumed the message, or whether it should be propagated).
355 474
356For propagation, a context can have any number of attached I<parent 475For propagation, a context can have any number of attached I<slave
357contexts>. Any message that is neither masked by the logging mask nor 476contexts>. Any message that is neither masked by the logging mask nor
358masked by the logging callback returning true will be passed to all parent 477masked by the logging callback returning true will be passed to all slave
359contexts. 478contexts.
479
480Each call to a logging function will log the message at most once per
481context, so it does not matter (much) if there are cycles or if the
482message can arrive at the same context via multiple paths.
360 483
361=head2 DEFAULTS 484=head2 DEFAULTS
362 485
363By default, all logging contexts have an full set of log levels ("all"), a 486By default, all logging contexts have an full set of log levels ("all"), a
364disabled logging callback and the default formatting callback. 487disabled logging callback and the default formatting callback.
365 488
366Package contexts have the package name as logging title by default. 489Package contexts have the package name as logging title by default.
367 490
368They have exactly one parent - the context of the "parent" package. The 491They have exactly one slave - the context of the "parent" package. The
369parent package is simply defined to be the package name without the last 492parent package is simply defined to be the package name without the last
370component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>, 493component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
371and C<AnyEvent> becomes the empty string. 494and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
495exception of the rule - just like the "parent" of any single-component
496package name in Perl is C<main>, the default slave of any top-level
497package context is C<$AnyEvent::Log::COLLECT>.
372 498
373Since perl packages form only an approximate hierarchy, this parent 499Since perl packages form only an approximate hierarchy, this slave
374context can of course be removed. 500context can of course be removed.
375 501
376All other (anonymous) contexts have no parents and an empty title by 502All other (anonymous) contexts have no slaves and an empty title by
377default. 503default.
378 504
379When the module is first loaded, it configures the root context (the one 505When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
380with the empty string) to simply dump all log messages to C<STDERR>, 506context that simply logs everything via C<warn>, without propagating
381and sets it's log level set to all levels up to the one specified by 507anything anywhere by default. The purpose of this context is to provide
382C<$ENV{PERL_ANYEVENT_VERBOSE}>. 508a convenient place to override the global logging target or to attach
509additional log targets. It's not meant for filtering.
510
511It then creates the C<$AnyEvent::Log::FILTER> context whose
512purpose is to suppress all messages with priority higher
513than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
514C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
515is to simply provide filtering according to some global log level.
516
517Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
518and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
519leaves it at default config. Its purpose is simply to collect all log
520messages system-wide.
521
522The hierarchy is then:
523
524 any package, eventually -> $COLLECT -> $FILTER -> $LOG
383 525
384The effect of all this is that log messages, by default, wander up to the 526The effect of all this is that log messages, by default, wander up to the
385root context and will be logged to STDERR if their log level is less than 527C<$AnyEvent::Log::COLLECT> context where all messages normally end up,
386or equal to C<$ENV{PERL_ANYEVENT_VERBOSE}>. 528from there to C<$AnyEvent::Log::FILTER> where log messages with lower
529priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
530to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
387 531
532This makes it easy to set a global logging level (by modifying $FILTER),
533but still allow other contexts to send, for example, their debug and trace
534messages to the $LOG target despite the global logging level, or to attach
535additional log targets that log messages, regardless of the global logging
536level.
537
538It also makes it easy to modify the default warn-logger ($LOG) to
539something that logs to a file, or to attach additional logging targets
540(such as loggign to a file) by attaching it to $FILTER.
541
388=head2 CREATING/FINDING A CONTEXT 542=head2 CREATING/FINDING/DESTROYING CONTEXTS
389 543
390=over 4 544=over 4
391 545
392=item $ctx = AnyEvent::Log::ctx [$pkg] 546=item $ctx = AnyEvent::Log::ctx [$pkg]
393 547
411 : defined $pkg 565 : defined $pkg
412 ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg 566 ? $CTX{$pkg} ||= AnyEvent::Log::_pkg_ctx $pkg
413 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" 567 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
414} 568}
415 569
416# create default root context 570=item AnyEvent::Log::reset
417{ 571
418 my $root = ctx undef; 572Resets all package contexts and recreates the default hierarchy if
419 $root->[0] = ""; 573necessary, i.e. resets the logging subsystem to defaults, as much as
420 $root->title ("default"); 574possible. This process keeps references to contexts held by other parts of
421 $root->level ($AnyEvent::VERBOSE); undef $AnyEvent::VERBOSE; 575the program intact.
422 $root->log_cb (sub { 576
423 print STDERR shift; 577This can be used to implement config-file (re-)loading: before loading a
424 0 578configuration, reset all contexts.
579
580=cut
581
582our $ORIG_VERBOSE = $AnyEvent::VERBOSE;
583$AnyEvent::VERBOSE = 9;
584
585sub reset {
586 # hard to kill complex data structures
587 # we "recreate" all package loggers and reset the hierarchy
588 while (my ($k, $v) = each %CTX) {
589 @$v = ($k, (1 << 10) - 1 - 1, { });
590
591 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
425 }); 592 }
426 $CTX{""} = $root; 593
594 @$_ = ($_->[0], (1 << 10) - 1 - 1)
595 for $LOG, $FILTER, $COLLECT;
596
597 #$LOG->slaves;
598 $LOG->title ('$AnyEvent::Log::LOG');
599 $LOG->log_to_warn;
600
601 $FILTER->slaves ($LOG);
602 $FILTER->title ('$AnyEvent::Log::FILTER');
603 $FILTER->level ($ORIG_VERBOSE);
604
605 $COLLECT->slaves ($FILTER);
606 $COLLECT->title ('$AnyEvent::Log::COLLECT');
607
608 _reassess;
427} 609}
610
611# override AE::log/logger
612*AnyEvent::log = *AE::log = \&log;
613*AnyEvent::logger = *AE::logger = \&logger;
614
615# convert AnyEvent loggers to AnyEvent::Log loggers
616$_->[0] = ctx $_->[0] # convert "pkg" to "ctx"
617 for values %LOGGER;
618
619# create the default logger contexts
620$LOG = ctx undef;
621$FILTER = ctx undef;
622$COLLECT = ctx undef;
623
624AnyEvent::Log::reset;
625
626# hello, CPAN, please catch me
627package AnyEvent::Log::LOG;
628package AE::Log::LOG;
629package AnyEvent::Log::FILTER;
630package AE::Log::FILTER;
631package AnyEvent::Log::COLLECT;
632package AE::Log::COLLECT;
633
634package AnyEvent::Log::Ctx;
635
636=item $ctx = new AnyEvent::Log::Ctx methodname => param...
637
638This is a convenience constructor that makes it simpler to construct
639anonymous logging contexts.
640
641Each key-value pair results in an invocation of the method of the same
642name as the key with the value as parameter, unless the value is an
643arrayref, in which case it calls the method with the contents of the
644array. The methods are called in the same order as specified.
645
646Example: create a new logging context and set both the default logging
647level, some slave contexts and a logging callback.
648
649 $ctx = new AnyEvent::Log::Ctx
650 title => "dubious messages",
651 level => "error",
652 log_cb => sub { print STDOUT shift; 0 },
653 slaves => [$ctx1, $ctx, $ctx2],
654 ;
428 655
429=back 656=back
430 657
431=cut 658=cut
432 659
433package AnyEvent::Log::Ctx; 660sub new {
661 my $class = shift;
434 662
435# 0 1 2 3 4 663 my $ctx = AnyEvent::Log::ctx undef;
436# [$title, $level, %$parents, &$logcb, &$fmtcb] 664
665 while (@_) {
666 my ($k, $v) = splice @_, 0, 2;
667 $ctx->$k (ref $v eq "ARRAY" ? @$v : $v);
668 }
669
670 bless $ctx, $class # do we really support subclassing, hmm?
671}
672
437 673
438=head2 CONFIGURING A LOG CONTEXT 674=head2 CONFIGURING A LOG CONTEXT
439 675
440The following methods can be used to configure the logging context. 676The following methods can be used to configure the logging context.
441 677
490Enables logging for the given levels, leaving all others unchanged. 726Enables logging for the given levels, leaving all others unchanged.
491 727
492=item $ctx->disable ($level[, $level...]) 728=item $ctx->disable ($level[, $level...])
493 729
494Disables logging for the given levels, leaving all others unchanged. 730Disables logging for the given levels, leaving all others unchanged.
731
732=item $ctx->cap ($level)
733
734Caps the maximum priority to the given level, for all messages logged
735to, or passing through, this context. That is, while this doesn't affect
736whether a message is logged or passed on, the maximum priority of messages
737will be limited to the specified level - messages with a higher priority
738will be set to the specified priority.
739
740Another way to view this is that C<< ->level >> filters out messages with
741a too low priority, while C<< ->cap >> modifies messages with a too high
742priority.
743
744This is useful when different log targets have different interpretations
745of priority. For example, for a specific command line program, a wrong
746command line switch might well result in a C<fatal> log message, while the
747same message, logged to syslog, is likely I<not> fatal to the system or
748syslog facility as a whole, but more likely a mere C<error>.
749
750This can be modeled by having a stderr logger that logs messages "as-is"
751and a syslog logger that logs messages with a level cap of, say, C<error>,
752or, for truly system-critical components, actually C<critical>.
495 753
496=cut 754=cut
497 755
498sub _lvl_lst { 756sub _lvl_lst {
499 map { 757 map {
501 : $_ eq "all" ? (1 .. 9) 759 : $_ eq "all" ? (1 .. 9)
502 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught" 760 : $STR2LEVEL{$_} || Carp::croak "$_: not a valid logging level, caught"
503 } @_ 761 } @_
504} 762}
505 763
764sub _lvl {
765 $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1]
766}
767
506our $NOP_CB = sub { 0 }; 768our $NOP_CB = sub { 0 };
507 769
508sub levels { 770sub levels {
509 my $ctx = shift; 771 my $ctx = shift;
510 $ctx->[1] = 0; 772 $ctx->[1] = 0;
513 AnyEvent::Log::_reassess; 775 AnyEvent::Log::_reassess;
514} 776}
515 777
516sub level { 778sub level {
517 my $ctx = shift; 779 my $ctx = shift;
518 my $lvl = $_[0] =~ /^(?:0|off|none)$/ ? 0 : (_lvl_lst $_[0])[-1];
519
520 $ctx->[1] = ((1 << $lvl) - 1) << 1; 780 $ctx->[1] = ((1 << &_lvl) - 1) << 1;
521 AnyEvent::Log::_reassess; 781 AnyEvent::Log::_reassess;
522} 782}
523 783
524sub enable { 784sub enable {
525 my $ctx = shift; 785 my $ctx = shift;
533 $ctx->[1] &= ~(1 << $_) 793 $ctx->[1] &= ~(1 << $_)
534 for &_lvl_lst; 794 for &_lvl_lst;
535 AnyEvent::Log::_reassess; 795 AnyEvent::Log::_reassess;
536} 796}
537 797
798sub cap {
799 my $ctx = shift;
800 $ctx->[5] = &_lvl;
801}
802
538=back 803=back
539 804
540=head3 PARENT CONTEXTS 805=head3 SLAVE CONTEXTS
541 806
542The following methods attach and detach another logging context to a 807The following methods attach and detach another logging context to a
543logging context. 808logging context.
544 809
545Log messages are propagated to all parent contexts, unless the logging 810Log messages are propagated to all slave contexts, unless the logging
546callback consumes the message. 811callback consumes the message.
547 812
548=over 4 813=over 4
549 814
550=item $ctx->attach ($ctx2[, $ctx3...]) 815=item $ctx->attach ($ctx2[, $ctx3...])
551 816
552Attaches the given contexts as parents to this context. It is not an error 817Attaches the given contexts as slaves to this context. It is not an error
553to add a context twice (the second add will be ignored). 818to add a context twice (the second add will be ignored).
554 819
555A context can be specified either as package name or as a context object. 820A context can be specified either as package name or as a context object.
556 821
557=item $ctx->detach ($ctx2[, $ctx3...]) 822=item $ctx->detach ($ctx2[, $ctx3...])
558 823
559Removes the given parents from this context - it's not an error to attempt 824Removes the given slaves from this context - it's not an error to attempt
560to remove a context that hasn't been added. 825to remove a context that hasn't been added.
561 826
562A context can be specified either as package name or as a context object. 827A context can be specified either as package name or as a context object.
828
829=item $ctx->slaves ($ctx2[, $ctx3...])
830
831Replaces all slaves attached to this context by the ones given.
563 832
564=cut 833=cut
565 834
566sub attach { 835sub attach {
567 my $ctx = shift; 836 my $ctx = shift;
575 844
576 delete $ctx->[2]{$_+0} 845 delete $ctx->[2]{$_+0}
577 for map { AnyEvent::Log::ctx $_ } @_; 846 for map { AnyEvent::Log::ctx $_ } @_;
578} 847}
579 848
849sub slaves {
850 undef $_[0][2];
851 &attach;
852}
853
580=back 854=back
581 855
582=head3 MESSAGE LOGGING 856=head3 LOG TARGETS
583 857
584The following methods configure how the logging context actually does 858The following methods configure how the logging context actually does
585the logging (which consists of formatting the message and printing it or 859the logging (which consists of formatting the message and printing it or
586whatever it wants to do with it) and also allows you to log messages 860whatever it wants to do with it).
587directly to a context, without going via your package context.
588 861
589=over 4 862=over 4
590 863
591=item $ctx->log_cb ($cb->($str)) 864=item $ctx->log_cb ($cb->($str)
592 865
593Replaces the logging callback on the context (C<undef> disables the 866Replaces the logging callback on the context (C<undef> disables the
594logging callback). 867logging callback).
595 868
596The logging callback is responsible for handling formatted log messages 869The logging callback is responsible for handling formatted log messages
597(see C<fmt_cb> below) - normally simple text strings that end with a 870(see C<fmt_cb> below) - normally simple text strings that end with a
598newline (and are possibly multiline themselves). 871newline (and are possibly multiline themselves).
599 872
600It also has to return true iff it has consumed the log message, and false 873It also has to return true iff it has consumed the log message, and false
601if it hasn't. Consuming a message means that it will not be sent to any 874if it hasn't. Consuming a message means that it will not be sent to any
602parent context. When in doubt, return C<0> from your logging callback. 875slave context. When in doubt, return C<0> from your logging callback.
603 876
604Example: a very simple logging callback, simply dump the message to STDOUT 877Example: a very simple logging callback, simply dump the message to STDOUT
605and do not consume it. 878and do not consume it.
606 879
607 $ctx->log_cb (sub { print STDERR shift; 0 }); 880 $ctx->log_cb (sub { print STDERR shift; 0 });
615your program. 888your program.
616 889
617 $ctx->levels ("debug", "trace"); 890 $ctx->levels ("debug", "trace");
618 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages 891 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
619 892
620=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message)) 893=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
621 894
622Replaces the formatting callback on the context (C<undef> restores the 895Replaces the formatting callback on the context (C<undef> restores the
623default formatter). 896default formatter).
624 897
625The callback is passed the (possibly fractional) timestamp, the original 898The callback is passed the (possibly fractional) timestamp, the original
626logging context, the (numeric) logging level and the raw message string and needs to 899logging context, the (numeric) logging level and the raw message string
627return a formatted log message. In most cases this will be a string, but 900and needs to return a formatted log message. In most cases this will be a
628it could just as well be an array reference that just stores the values. 901string, but it could just as well be an array reference that just stores
902the values.
903
904If, for some reason, you want to use C<caller> to find out more baout the
905logger then you should walk up the call stack until you are no longer
906inside the C<AnyEvent::Log> package.
629 907
630Example: format just the raw message, with numeric log level in angle 908Example: format just the raw message, with numeric log level in angle
631brackets. 909brackets.
632 910
633 $ctx->fmt_cb (sub { 911 $ctx->fmt_cb (sub {
650 "$msg->[3]"; 928 "$msg->[3]";
651 929
652 0 930 0
653 }); 931 });
654 932
933=item $ctx->log_to_warn
934
935Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
936(usually this logs to STDERR).
937
938=item $ctx->log_to_file ($path)
939
940Sets the C<log_cb> to log to a file (by appending), unbuffered.
941
942=item $ctx->log_to_path ($path)
943
944Same as C<< ->log_to_file >>, but opens the file for each message. This
945is much slower, but allows you to change/move/rename/delete the file at
946basically any time.
947
948Needless(?) to say, if you do not want to be bitten by some evil person
949calling C<chdir>, the path should be absolute. Doesn't help with
950C<chroot>, but hey...
951
952=item $ctx->log_to_syslog ([$facility])
953
954Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and
955all the others in the obvious way. If specified, then the C<$facility> is
956used as the facility (C<user>, C<auth>, C<local0> and so on). The default
957facility is C<user>.
958
959Note that this function also sets a C<fmt_cb> - the logging part requires
960an array reference with [$level, $str] as input.
961
655=cut 962=cut
656 963
657sub log_cb { 964sub log_cb {
658 my ($ctx, $cb) = @_; 965 my ($ctx, $cb) = @_;
659 966
664 my ($ctx, $cb) = @_; 971 my ($ctx, $cb) = @_;
665 972
666 $ctx->[4] = $cb; 973 $ctx->[4] = $cb;
667} 974}
668 975
976sub log_to_warn {
977 my ($ctx, $path) = @_;
978
979 $ctx->log_cb (sub {
980 warn shift;
981 0
982 });
983}
984
985sub log_to_file {
986 my ($ctx, $path) = @_;
987
988 open my $fh, ">>", $path
989 or die "$path: $!";
990
991 $ctx->log_cb (sub {
992 syswrite $fh, shift;
993 0
994 });
995}
996
997sub log_to_path {
998 my ($ctx, $path) = @_;
999
1000 $ctx->log_cb (sub {
1001 open my $fh, ">>", $path
1002 or die "$path: $!";
1003
1004 syswrite $fh, shift;
1005 0
1006 });
1007}
1008
1009sub log_to_syslog {
1010 my ($ctx, $facility) = @_;
1011
1012 require Sys::Syslog;
1013
1014 $ctx->fmt_cb (sub {
1015 my $str = $_[3];
1016 $str =~ s/\n(?=.)/\n+ /g;
1017
1018 [$_[2], "($_[1][0]) $str"]
1019 });
1020
1021 $facility ||= "user";
1022
1023 $ctx->log_cb (sub {
1024 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
1025
1026 Sys::Syslog::syslog ("$facility|" . ($lvl - 1), $_)
1027 for split /\n/, $_[0][1];
1028
1029 0
1030 });
1031}
1032
1033=back
1034
1035=head3 MESSAGE LOGGING
1036
1037These methods allow you to log messages directly to a context, without
1038going via your package context.
1039
1040=over 4
1041
669=item $ctx->log ($level, $msg[, @params]) 1042=item $ctx->log ($level, $msg[, @params])
670 1043
671Same as C<AnyEvent::Log::log>, but uses the given context as log context. 1044Same as C<AnyEvent::Log::log>, but uses the given context as log context.
672 1045
673=item $logger = $ctx->logger ($level[, \$enabled]) 1046=item $logger = $ctx->logger ($level[, \$enabled])
678=cut 1051=cut
679 1052
680*log = \&AnyEvent::Log::_log; 1053*log = \&AnyEvent::Log::_log;
681*logger = \&AnyEvent::Log::_logger; 1054*logger = \&AnyEvent::Log::_logger;
682 1055
1056=back
1057
1058=cut
1059
1060package AnyEvent::Log;
1061
1062=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
1063
1064Logging can also be configured by setting the environment variable
1065C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
1066
1067The value consists of one or more logging context specifications separated
1068by C<:> or whitespace. Each logging specification in turn starts with a
1069context name, followed by C<=>, followed by zero or more comma-separated
1070configuration directives, here are some examples:
1071
1072 # set default logging level
1073 filter=warn
1074
1075 # log to file instead of to stderr
1076 log=file=/tmp/mylog
1077
1078 # log to file in addition to stderr
1079 log=+%file:%file=file=/tmp/mylog
1080
1081 # enable debug log messages, log warnings and above to syslog
1082 filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
1083
1084 # log trace messages (only) from AnyEvent::Debug to file
1085 AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
1086
1087A context name in the log specification can be any of the following:
1088
1089=over 4
1090
1091=item C<collect>, C<filter>, C<log>
1092
1093Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
1094C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
1095
1096=item C<%name>
1097
1098Context names starting with a C<%> are anonymous contexts created when the
1099name is first mentioned. The difference to package contexts is that by
1100default they have no attached slaves.
1101
1102=item a perl package name
1103
1104Any other string references the logging context associated with the given
1105Perl C<package>. In the unlikely case where you want to specify a package
1106context that matches on of the other context name forms, you can add a
1107C<::> to the package name to force interpretation as a package.
1108
1109=back
1110
1111The configuration specifications can be any number of the following:
1112
1113=over 4
1114
1115=item C<stderr>
1116
1117Configures the context to use Perl's C<warn> function (which typically
1118logs to C<STDERR>). Works like C<log_to_warn>.
1119
1120=item C<file=>I<path>
1121
1122Configures the context to log to a file with the given path. Works like
1123C<log_to_file>.
1124
1125=item C<path=>I<path>
1126
1127Configures the context to log to a file with the given path. Works like
1128C<log_to_path>.
1129
1130=item C<syslog> or C<syslog=>I<expr>
1131
1132Configures the context to log to syslog. If I<expr> is given, then it is
1133evaluated in the L<Sys::Syslog> package, so you could use:
1134
1135 log=syslog=LOG_LOCAL0
1136
1137=item C<nolog>
1138
1139Configures the context to not log anything by itself, which is the
1140default. Same as C<< $ctx->log_cb (undef) >>.
1141
1142=item C<cap=>I<level>
1143
1144Caps logging messages entering this context at the given level, i.e.
1145reduces the priority of messages with higher priority than this level. The
1146default is C<0> (or C<off>), meaning the priority will not be touched.
1147
1148=item C<0> or C<off>
1149
1150Sets the logging level of the context to C<0>, i.e. all messages will be
1151filtered out.
1152
1153=item C<all>
1154
1155Enables all logging levels, i.e. filtering will effectively be switched
1156off (the default).
1157
1158=item C<only>
1159
1160Disables all logging levels, and changes the interpretation of following
1161level specifications to enable the specified level only.
1162
1163Example: only enable debug messages for a context.
1164
1165 context=only,debug
1166
1167=item C<except>
1168
1169Enables all logging levels, and changes the interpretation of following
1170level specifications to disable that level. Rarely used.
1171
1172Example: enable all logging levels except fatal and trace (this is rather
1173nonsensical).
1174
1175 filter=exept,fatal,trace
1176
1177=item C<level>
1178
1179Enables all logging levels, and changes the interpretation of following
1180level specifications to be "that level or any higher priority
1181message". This is the default.
1182
1183Example: log anything at or above warn level.
1184
1185 filter=warn
1186
1187 # or, more verbose
1188 filter=only,level,warn
1189
1190=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
1191
1192A numeric loglevel or the name of a loglevel will be interpreted according
1193to the most recent C<only>, C<except> or C<level> directive. By default,
1194specifying a logging level enables that and any higher priority messages.
1195
1196=item C<+>I<context>
1197
1198Attaches the named context as slave to the context.
1199
1200=item C<+>
1201
1202A line C<+> detaches all contexts, i.e. clears the slave list from the
1203context. Anonymous (C<%name>) contexts have no attached slaves by default,
1204but package contexts have the parent context as slave by default.
1205
1206Example: log messages from My::Module to a file, do not send them to the
1207default log collector.
1208
1209 My::Module=+,file=/tmp/mymodulelog
1210
1211=back
1212
1213Any character can be escaped by prefixing it with a C<\> (backslash), as
1214usual, so to log to a file containing a comma, colon, backslash and some
1215spaces in the filename, you would do this:
1216
1217 PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
1218
1219Since whitespace (which includes newlines) is allowed, it is fine to
1220specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
1221
1222 PERL_ANYEVENT_LOG="
1223 filter=warn
1224 AnyEvent::Debug=+%trace
1225 %trace=only,trace,+log
1226 " myprog
1227
1228Also, in the unlikely case when you want to concatenate specifications,
1229use whitespace as separator, as C<::> will be interpreted as part of a
1230module name, an empty spec with two separators:
1231
1232 PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
1233
1234=cut
1235
1236for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1237 my %anon;
1238
1239 my $pkg = sub {
1240 $_[0] eq "log" ? $LOG
1241 : $_[0] eq "filter" ? $FILTER
1242 : $_[0] eq "collect" ? $COLLECT
1243 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= do { my $ctx = ctx undef; $ctx->[0] = $_[0]; $ctx })
1244 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1245 : die # never reached?
1246 };
1247
1248 /\G[[:space:]]+/gc; # skip initial whitespace
1249
1250 while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
1251 my $ctx = $pkg->($1);
1252 my $level = "level";
1253
1254 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1255 for ("$1") {
1256 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1257 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1258 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1259 } elsif (/^syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog ("$1");
1260 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1261 } elsif (/^cap=(.+)/ ) { $ctx->cap ("$1");
1262 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1263 } elsif ($_ eq "+" ) { $ctx->slaves;
1264 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1265 } elsif ($_ eq "all" ) { $ctx->level ("all");
1266 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1267 } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
1268 } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
1269 } elsif (/^\d$/ ) { $ctx->$level ($_);
1270 } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
1271 } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
1272 }
1273 }
1274
1275 /\G,/gc or last;
1276 }
1277
1278 /\G[:[:space:]]+/gc or last;
1279 }
1280
1281 /\G[[:space:]]+/gc; # skip trailing whitespace
1282
1283 if (/\G(.+)/g) {
1284 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1285 }
1286}
1287
6831; 12881;
1289
1290=head1 EXAMPLES
1291
1292This section shows some common configurations, both as code, and as
1293C<PERL_ANYEVENT_LOG> string.
1294
1295=over 4
1296
1297=item Setting the global logging level.
1298
1299Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
1300running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
1301the root context at runtime:
1302
1303 PERL_ANYEVENT_VERBOSE=5 ./myprog
1304
1305 PERL_ANYEVENT_LOG=log=warn
1306
1307 $AnyEvent::Log::FILTER->level ("warn");
1308
1309=item Append all messages to a file instead of sending them to STDERR.
1310
1311This is affected by the global logging level.
1312
1313 $AnyEvent::Log::LOG->log_to_file ($path);
1314
1315 PERL_ANYEVENT_LOG=log=file=/some/path
1316
1317=item Write all messages with priority C<error> and higher to a file.
1318
1319This writes them only when the global logging level allows it, because
1320it is attached to the default context which is invoked I<after> global
1321filtering.
1322
1323 $AnyEvent::Log::FILTER->attach (
1324 new AnyEvent::Log::Ctx log_to_file => $path);
1325
1326 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
1327
1328This writes them regardless of the global logging level, because it is
1329attached to the toplevel context, which receives all messages I<before>
1330the global filtering.
1331
1332 $AnyEvent::Log::COLLECT->attach (
1333 new AnyEvent::Log::Ctx log_to_file => $path);
1334
1335 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1336
1337In both cases, messages are still written to STDERR.
1338
1339=item Additionally log all messages with C<warn> and higher priority to
1340C<syslog>, but cap at C<error>.
1341
1342This logs all messages to the default log target, but also logs messages
1343with priority C<warn> or higher (and not filtered otherwise) to syslog
1344facility C<user>. Messages with priority higher than C<error> will be
1345logged with level C<error>.
1346
1347 $AnyEvent::Log::LOG->attach (
1348 new AnyEvent::Log::Ctx
1349 level => "warn",
1350 cap => "error",
1351 syslog => "user",
1352 );
1353
1354 PERL_ANYEVENT_LOG=log=+%syslog:%syslog=warn,cap=error,syslog
1355
1356=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
1357
1358Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
1359context - this simply circumvents the global filtering for trace messages.
1360
1361 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
1362 $debug->attach ($AnyEvent::Log::LOG);
1363
1364 PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
1365
1366This of course works for any package, not just L<AnyEvent::Debug>, but
1367assumes the log level for AnyEvent::Debug hasn't been changed from the
1368default.
684 1369
685=back 1370=back
686 1371
687=head1 AUTHOR 1372=head1 AUTHOR
688 1373
689 Marc Lehmann <schmorp@schmorp.de> 1374 Marc Lehmann <schmorp@schmorp.de>
690 http://home.schmorp.de/ 1375 http://home.schmorp.de/
691 1376
692=cut 1377=cut
1378

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines