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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines