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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines