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.13 by root, Sat Aug 20 01:34:12 2011 UTC vs.
Revision 1.36 by root, Thu Aug 25 05:39:47 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 => 0,
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, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number before 49will be logged, unless you set C<PERL_ANYEVENT_VERBOSE> to a higher number
51starting your program, or change the logging level at runtime with 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
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 (); 116use AnyEvent::Util ();
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 : "AE::Log::Top"; 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.
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,
195 ? $level+0 238 ? $level+0
196 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught"; 239 : $STR2LEVEL{$level} || Carp::croak "$level: not a valid logging level, caught";
197 240
198 my $mask = 1 << $level; 241 my $mask = 1 << $level;
199 242
200 my (%seen, @ctx, $now, $fmt); 243 my ($success, %seen, @ctx, $now, $fmt);
201 244
202 do 245 do
203 { 246 {
204 # skip if masked 247 # skip if masked
205 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) { 248 if ($ctx->[1] & $mask && !$seen{$ctx+0}++) {
209 # now get raw message, unless we have it already 252 # now get raw message, unless we have it already
210 unless ($now) { 253 unless ($now) {
211 $format = $format->() if ref $format; 254 $format = $format->() if ref $format;
212 $format = sprintf $format, @args if @args; 255 $format = sprintf $format, @args if @args;
213 $format =~ s/\n$//; 256 $format =~ s/\n$//;
214 $now = AE::now; 257 $now = now;
215 }; 258 };
216 259
217 # format msg 260 # format msg
218 my $str = $ctx->[4] 261 my $str = $ctx->[4]
219 ? $ctx->[4]($now, $_[0], $level, $format) 262 ? $ctx->[4]($now, $_[0], $level, $format)
220 : $fmt ||= _format $now, $_[0], $level, $format; 263 : ($fmt ||= _format $now, $_[0], $level, $format);
221 264
265 $success = 1;
266
222 $ctx->[3]($str); 267 $ctx->[3]($str)
268 or push @ctx, values %{ $ctx->[2] }; # not consumed - propagate
269 } else {
270 push @ctx, values %{ $ctx->[2] }; # not masked - propagate
223 } 271 }
224
225 # not masked, not consumed - propagate to parent contexts
226 push @ctx, values %{ $ctx->[2] };
227 } 272 }
228 } 273 }
229 while $ctx = pop @ctx; 274 while $ctx = pop @ctx;
230 275
231 exit 1 if $level <= 1; 276 exit 1 if $level <= 1;
277
278 $success
232} 279}
233 280
234sub log($$;@) { 281sub log($$;@) {
235 _log 282 _log
236 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], 283 $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0],
240*AnyEvent::log = *AE::log = \&log; 287*AnyEvent::log = *AE::log = \&log;
241 288
242=item $logger = AnyEvent::Log::logger $level[, \$enabled] 289=item $logger = AnyEvent::Log::logger $level[, \$enabled]
243 290
244Creates a code reference that, when called, acts as if the 291Creates a code reference that, when called, acts as if the
245C<AnyEvent::Log::log> function was called at this point with the givne 292C<AnyEvent::Log::log> function was called at this point with the given
246level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with 293level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with
247the C<AnyEvent::Log::log> function: 294the C<AnyEvent::Log::log> function:
248 295
249 my $debug_log = AnyEvent::Log::logger "debug"; 296 my $debug_log = AnyEvent::Log::logger "debug";
250 297
275 # and later in your program 322 # and later in your program
276 $debug_log->("yo, stuff here") if $debug; 323 $debug_log->("yo, stuff here") if $debug;
277 324
278 $debug and $debug_log->("123"); 325 $debug and $debug_log->("123");
279 326
280Note: currently the enabled var is always true - that will be fixed in a
281future version :)
282
283=cut 327=cut
284 328
285our %LOGGER; 329our %LOGGER;
286 330
287# re-assess logging status for all loggers 331# re-assess logging status for all loggers
288sub _reassess { 332sub _reassess {
333 local $SIG{__DIE__};
334 my $die = sub { die };
335
289 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) { 336 for (@_ ? $LOGGER{$_[0]} : values %LOGGER) {
290 my ($ctx, $level, $renabled) = @$_; 337 my ($ctx, $level, $renabled) = @$_;
291 338
292 # to detect whether a message would be logged, we # actually 339 # to detect whether a message would be logged, we actually
293 # try to log one and die. this isn't fast, but we can be 340 # try to log one and die. this isn't fast, but we can be
294 # sure that the logging decision is correct :) 341 # sure that the logging decision is correct :)
295 342
296 $$renabled = !eval { 343 $$renabled = !eval {
297 local $SIG{__DIE__};
298
299 _log $ctx, $level, sub { die }; 344 _log $ctx, $level, $die;
300 345
301 1 346 1
302 }; 347 };
303
304 $$renabled = 1; # TODO
305 } 348 }
306} 349}
307 350
308sub _logger($;$) { 351sub _logger {
309 my ($ctx, $level, $renabled) = @_; 352 my ($ctx, $level, $renabled) = @_;
310
311 $renabled ||= \my $enabled;
312 353
313 $$renabled = 1; 354 $$renabled = 1;
314 355
315 my $logger = [$ctx, $level, $renabled]; 356 my $logger = [$ctx, $level, $renabled];
316 357
356timestamp, context, level and string message and formats it in the way 397timestamp, context, level and string message and formats it in the way
357it should be logged) and a logging callback (which is responsible for 398it should be logged) and a logging callback (which is responsible for
358actually logging the formatted message and telling C<AnyEvent::Log> 399actually logging the formatted message and telling C<AnyEvent::Log>
359whether it has consumed the message, or whether it should be propagated). 400whether it has consumed the message, or whether it should be propagated).
360 401
361For propagation, a context can have any number of attached I<parent 402For propagation, a context can have any number of attached I<slave
362contexts>. Any message that is neither masked by the logging mask nor 403contexts>. Any message that is neither masked by the logging mask nor
363masked by the logging callback returning true will be passed to all parent 404masked by the logging callback returning true will be passed to all slave
364contexts. 405contexts.
365 406
366Each call to a logging function will log the message at most once per 407Each call to a logging function will log the message at most once per
367context, so it does not matter (much) if there are cycles or if the 408context, so it does not matter (much) if there are cycles or if the
368message can arrive at the same context via multiple paths. 409message can arrive at the same context via multiple paths.
372By default, all logging contexts have an full set of log levels ("all"), a 413By default, all logging contexts have an full set of log levels ("all"), a
373disabled logging callback and the default formatting callback. 414disabled logging callback and the default formatting callback.
374 415
375Package contexts have the package name as logging title by default. 416Package contexts have the package name as logging title by default.
376 417
377They have exactly one parent - the context of the "parent" package. The 418They have exactly one slave - the context of the "parent" package. The
378parent package is simply defined to be the package name without the last 419parent package is simply defined to be the package name without the last
379component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>, 420component, i.e. C<AnyEvent::Debug::Wrapped> becomes C<AnyEvent::Debug>,
380and C<AnyEvent> becomes ... C<AnyEvent::Log::Top> which is the 421and C<AnyEvent> becomes ... C<$AnyEvent::Log::COLLECT> which is the
381exception of the rule - just like the parent of any package name in 422exception of the rule - just like the "parent" of any single-component
382Perl is C<main>, the default parent of any top-level package context is 423package name in Perl is C<main>, the default slave of any top-level
383C<AnyEvent::Log::Top>. 424package context is C<$AnyEvent::Log::COLLECT>.
384 425
385Since perl packages form only an approximate hierarchy, this parent 426Since perl packages form only an approximate hierarchy, this slave
386context can of course be removed. 427context can of course be removed.
387 428
388All other (anonymous) contexts have no parents and an empty title by 429All other (anonymous) contexts have no slaves and an empty title by
389default. 430default.
390 431
391When the module is loaded it creates the default context called 432When the module is loaded it creates the C<$AnyEvent::Log::LOG> logging
392C<AnyEvent::Log::Default> (also stored in C<$AnyEvent::Log::Default>), 433context that simply logs everything via C<warn>, without propagating
393which simply logs everything to STDERR and doesn't propagate anything
394anywhere by default. The purpose of the default context is to provide 434anything anywhere by default. The purpose of this context is to provide
395a convenient place to override the global logging target or to attach 435a convenient place to override the global logging target or to attach
396additional log targets. It's not meant for filtering. 436additional log targets. It's not meant for filtering.
397 437
398It then creates the root context called C<AnyEvent::Log::Root> (also 438It then creates the C<$AnyEvent::Log::FILTER> context whose
399stored in C<$AnyEvent::Log::Root>) and sets its log level set to all 439purpose is to suppress all messages with priority higher
400levels up to the one specified by C<$ENV{PERL_ANYEVENT_VERBOSE}>. It 440than C<$ENV{PERL_ANYEVENT_VERBOSE}>. It then attached the
401then attached the default logging context to it. The purpose of the root 441C<$AnyEvent::Log::LOG> context to it. The purpose of the filter context
402context is to simply provide filtering according to some global log level. 442is to simply provide filtering according to some global log level.
403 443
404Finally it creates the top-level package context called 444Finally it creates the top-level package context C<$AnyEvent::Log::COLLECT>
405C<AnyEvent::Log::Top> (also stored in, you might have guessed, 445and attaches the C<$AnyEvent::Log::FILTER> context to it, but otherwise
406C<$AnyEvent::Log::Top>) and attached the root context but otherwise leaves
407it at default config. It's purpose is simply to collect all log messages 446leaves it at default config. Its purpose is simply to collect all log
408system-wide. 447messages system-wide.
409 448
410These three special contexts can also be referred to by the 449The hierarchy is then:
411package/context names C<AE::Log::Default>, C<AE::Log::Root> and
412C<AE::Log::Top>.
413 450
451 any package, eventually -> $COLLECT -> $FILTER -> $LOG
452
414The effect of all this is that log messages, by default, wander up 453The effect of all this is that log messages, by default, wander up to the
415to the root context where log messages with lower priority then 454C<$AnyEvent::Log::COLLECT> context where all messages normally end up,
455from there to C<$AnyEvent::Log::FILTER> where log messages with lower
416C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered away and then to the 456priority then C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered out and then
417AnyEvent::Log::Default context to be logged to STDERR. 457to the C<$AnyEvent::Log::LOG> context to be passed to C<warn>.
418 458
419Splitting the top level context into three contexts makes it easy to set 459This makes it easy to set a global logging level (by modifying $FILTER),
420a global logging level (by modifying the root context), but still allow 460but still allow other contexts to send, for example, their debug and trace
421other contexts to log, for example, their debug and trace messages to the
422default target despite the global logging level, or to attach additional 461messages to the $LOG target despite the global logging level, or to attach
423log targets that log messages, regardless of the global logging level. 462additional log targets that log messages, regardless of the global logging
463level.
424 464
425It also makes it easy to replace the default STDERR-logger by something 465It also makes it easy to modify the default warn-logger ($LOG) to
426that logs to a file, or to attach additional logging targets. 466something that logs to a file, or to attach additional logging targets
467(such as loggign to a file) by attaching it to $FILTER.
427 468
428=head2 CREATING/FINDING/DESTROYING CONTEXTS 469=head2 CREATING/FINDING/DESTROYING CONTEXTS
429 470
430=over 4 471=over 4
431 472
453 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" 494 : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx"
454} 495}
455 496
456=item AnyEvent::Log::reset 497=item AnyEvent::Log::reset
457 498
458Deletes all contexts and recreates the default hierarchy, i.e. resets the 499Resets all package contexts and recreates the default hierarchy if
459logging subsystem to defaults. 500necessary, i.e. resets the logging subsystem to defaults, as much as
501possible. This process keeps references to contexts held by other parts of
502the program intact.
460 503
461This can be used to implement config-file (re-)loading: before loading a 504This can be used to implement config-file (re-)loading: before loading a
462configuration, reset all contexts. 505configuration, reset all contexts.
463 506
464=cut 507=cut
465 508
466sub reset { 509sub reset {
467 @$_ = () for values %CTX; # just to be sure - to kill circular logging dependencies 510 # hard to kill complex data structures
468 %CTX = (); 511 # we "recreate" all package loggers and reset the hierarchy
512 while (my ($k, $v) = each %CTX) {
513 @$v = ($k, (1 << 10) - 1 - 1, { });
469 514
470 my $default = ctx undef; 515 $v->attach ($k =~ /^(.+)::/ ? $CTX{$1} : $AnyEvent::Log::COLLECT);
471 $default->title ("AnyEvent::Log::Default");
472 $default->log_cb (sub {
473 print STDERR shift;
474 0
475 }); 516 }
476 $AnyEvent::Log::Default = $CTX{"AnyEvent::Log::Default"} = $CTX{"AE::Log::Default"} = $default;
477 517
478 my $root = ctx undef; 518 @$_ = ($_->[0], (1 << 10) - 1 - 1)
519 for $LOG, $FILTER, $COLLECT;
520
521 #$LOG->slaves;
479 $root->title ("AnyEvent::Log::Root"); 522 $LOG->title ('$AnyEvent::Log::LOG');
523 $LOG->log_to_warn;
524
525 $FILTER->slaves ($LOG);
526 $FILTER->title ('$AnyEvent::Log::FILTER');
480 $root->level ($AnyEvent::VERBOSE); 527 $FILTER->level ($AnyEvent::VERBOSE);
481 $root->attach ($default);
482 $AnyEvent::Log::Root = $CTX{"AnyEvent::Log::Root"} = $CTX{"AE::Log::Root"} = $root;
483 528
484 my $top = ctx undef; 529 $COLLECT->slaves ($FILTER);
485 $top->title ("AnyEvent::Log::Top"); 530 $COLLECT->title ('$AnyEvent::Log::COLLECT');
486 $top->attach ($root); 531
487 $AnyEvent::Log::Top = $CTX{"AnyEvent::Log::Top"} = $CTX{"AE::Log::Top"} = $top; 532 _reassess;
488} 533}
534
535# create the default logger contexts
536$LOG = ctx undef;
537$FILTER = ctx undef;
538$COLLECT = ctx undef;
489 539
490AnyEvent::Log::reset; 540AnyEvent::Log::reset;
491 541
492# hello, CPAN, please catch me 542# hello, CPAN, please catch me
493package AnyEvent::Log::Default;
494package AE::Log::Default;
495package AnyEvent::Log::Root;
496package AE::Log::Root;
497package AnyEvent::Log::Top; 543package AnyEvent::Log::LOG;
498package AE::Log::Top; 544package AE::Log::LOG;
545package AnyEvent::Log::FILTER;
546package AE::Log::FILTER;
547package AnyEvent::Log::COLLECT;
548package AE::Log::COLLECT;
499 549
500package AnyEvent::Log::Ctx; 550package AnyEvent::Log::Ctx;
501 551
502# 0 1 2 3 4 552# 0 1 2 3 4
503# [$title, $level, %$parents, &$logcb, &$fmtcb] 553# [$title, $level, %$slaves, &$logcb, &$fmtcb]
504 554
505=item $ctx = new AnyEvent::Log::Ctx methodname => param... 555=item $ctx = new AnyEvent::Log::Ctx methodname => param...
506 556
507This is a convenience constructor that makes it simpler to construct 557This is a convenience constructor that makes it simpler to construct
508anonymous logging contexts. 558anonymous logging contexts.
511name as the key with the value as parameter, unless the value is an 561name as the key with the value as parameter, unless the value is an
512arrayref, in which case it calls the method with the contents of the 562arrayref, in which case it calls the method with the contents of the
513array. The methods are called in the same order as specified. 563array. The methods are called in the same order as specified.
514 564
515Example: create a new logging context and set both the default logging 565Example: create a new logging context and set both the default logging
516level, some parent contexts and a logging callback. 566level, some slave contexts and a logging callback.
517 567
518 $ctx = new AnyEvent::Log::Ctx 568 $ctx = new AnyEvent::Log::Ctx
519 title => "dubious messages", 569 title => "dubious messages",
520 level => "error", 570 level => "error",
521 log_cb => sub { print STDOUT shift; 0 }, 571 log_cb => sub { print STDOUT shift; 0 },
522 parents => [$ctx1, $ctx, $ctx2], 572 slaves => [$ctx1, $ctx, $ctx2],
523 ; 573 ;
524 574
525=back 575=back
526 576
527=cut 577=cut
640 AnyEvent::Log::_reassess; 690 AnyEvent::Log::_reassess;
641} 691}
642 692
643=back 693=back
644 694
645=head3 PARENT CONTEXTS 695=head3 SLAVE CONTEXTS
646 696
647The following methods attach and detach another logging context to a 697The following methods attach and detach another logging context to a
648logging context. 698logging context.
649 699
650Log messages are propagated to all parent contexts, unless the logging 700Log messages are propagated to all slave contexts, unless the logging
651callback consumes the message. 701callback consumes the message.
652 702
653=over 4 703=over 4
654 704
655=item $ctx->attach ($ctx2[, $ctx3...]) 705=item $ctx->attach ($ctx2[, $ctx3...])
656 706
657Attaches the given contexts as parents to this context. It is not an error 707Attaches the given contexts as slaves to this context. It is not an error
658to add a context twice (the second add will be ignored). 708to add a context twice (the second add will be ignored).
659 709
660A context can be specified either as package name or as a context object. 710A context can be specified either as package name or as a context object.
661 711
662=item $ctx->detach ($ctx2[, $ctx3...]) 712=item $ctx->detach ($ctx2[, $ctx3...])
663 713
664Removes the given parents from this context - it's not an error to attempt 714Removes the given slaves from this context - it's not an error to attempt
665to remove a context that hasn't been added. 715to remove a context that hasn't been added.
666 716
667A context can be specified either as package name or as a context object. 717A context can be specified either as package name or as a context object.
668 718
669=item $ctx->parents ($ctx2[, $ctx3...]) 719=item $ctx->slaves ($ctx2[, $ctx3...])
670 720
671Replaces all parents attached to this context by the ones given. 721Replaces all slaves attached to this context by the ones given.
672 722
673=cut 723=cut
674 724
675sub attach { 725sub attach {
676 my $ctx = shift; 726 my $ctx = shift;
684 734
685 delete $ctx->[2]{$_+0} 735 delete $ctx->[2]{$_+0}
686 for map { AnyEvent::Log::ctx $_ } @_; 736 for map { AnyEvent::Log::ctx $_ } @_;
687} 737}
688 738
689sub parents { 739sub slaves {
690 undef $_[0][2]; 740 undef $_[0][2];
691 &attach; 741 &attach;
692} 742}
693 743
694=back 744=back
695 745
696=head3 MESSAGE LOGGING 746=head3 LOG TARGETS
697 747
698The following methods configure how the logging context actually does 748The following methods configure how the logging context actually does
699the logging (which consists of formatting the message and printing it or 749the logging (which consists of formatting the message and printing it or
700whatever it wants to do with it) and also allows you to log messages 750whatever it wants to do with it).
701directly to a context, without going via your package context.
702 751
703=over 4 752=over 4
704 753
705=item $ctx->log_cb ($cb->($str)) 754=item $ctx->log_cb ($cb->($str)
706 755
707Replaces the logging callback on the context (C<undef> disables the 756Replaces the logging callback on the context (C<undef> disables the
708logging callback). 757logging callback).
709 758
710The logging callback is responsible for handling formatted log messages 759The logging callback is responsible for handling formatted log messages
711(see C<fmt_cb> below) - normally simple text strings that end with a 760(see C<fmt_cb> below) - normally simple text strings that end with a
712newline (and are possibly multiline themselves). 761newline (and are possibly multiline themselves).
713 762
714It also has to return true iff it has consumed the log message, and false 763It also has to return true iff it has consumed the log message, and false
715if it hasn't. Consuming a message means that it will not be sent to any 764if it hasn't. Consuming a message means that it will not be sent to any
716parent context. When in doubt, return C<0> from your logging callback. 765slave context. When in doubt, return C<0> from your logging callback.
717 766
718Example: a very simple logging callback, simply dump the message to STDOUT 767Example: a very simple logging callback, simply dump the message to STDOUT
719and do not consume it. 768and do not consume it.
720 769
721 $ctx->log_cb (sub { print STDERR shift; 0 }); 770 $ctx->log_cb (sub { print STDERR shift; 0 });
729your program. 778your program.
730 779
731 $ctx->levels ("debug", "trace"); 780 $ctx->levels ("debug", "trace");
732 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages 781 $ctx->log_cb (sub { 1 }); # do not log, but eat debug and trace messages
733 782
734=item $ctx->fmt_cb ($fmt_cb->($timestamp, $ctx, $level, $message)) 783=item $ctx->fmt_cb ($fmt_cb->($timestamp, $orig_ctx, $level, $message))
735 784
736Replaces the formatting callback on the context (C<undef> restores the 785Replaces the formatting callback on the context (C<undef> restores the
737default formatter). 786default formatter).
738 787
739The callback is passed the (possibly fractional) timestamp, the original 788The callback is passed the (possibly fractional) timestamp, the original
740logging context, the (numeric) logging level and the raw message string and needs to 789logging context, the (numeric) logging level and the raw message string
741return a formatted log message. In most cases this will be a string, but 790and needs to return a formatted log message. In most cases this will be a
742it could just as well be an array reference that just stores the values. 791string, but it could just as well be an array reference that just stores
792the values.
793
794If, for some reason, you want to use C<caller> to find out more baout the
795logger then you should walk up the call stack until you are no longer
796inside the C<AnyEvent::Log> package.
743 797
744Example: format just the raw message, with numeric log level in angle 798Example: format just the raw message, with numeric log level in angle
745brackets. 799brackets.
746 800
747 $ctx->fmt_cb (sub { 801 $ctx->fmt_cb (sub {
764 "$msg->[3]"; 818 "$msg->[3]";
765 819
766 0 820 0
767 }); 821 });
768 822
823=item $ctx->log_to_warn
824
825Sets the C<log_cb> to simply use C<CORE::warn> to report any messages
826(usually this logs to STDERR).
827
828=item $ctx->log_to_file ($path)
829
830Sets the C<log_cb> to log to a file (by appending), unbuffered.
831
832=item $ctx->log_to_path ($path)
833
834Same as C<< ->log_to_file >>, but opens the file for each message. This
835is much slower, but allows you to change/move/rename/delete the file at
836basically any time.
837
838Needless(?) to say, if you do not want to be bitten by some evil person
839calling C<chdir>, the path should be absolute. Doesn't help with
840C<chroot>, but hey...
841
842=item $ctx->log_to_syslog ([$log_flags])
843
844Logs all messages via L<Sys::Syslog>, mapping C<trace> to C<debug> and all
845the others in the obvious way. If specified, then the C<$log_flags> are
846simply or'ed onto the priority argument and can contain any C<LOG_xxx>
847flags valid for Sys::Syslog::syslog, except for the priority levels.
848
849Note that this function also sets a C<fmt_cb> - the logging part requires
850an array reference with [$level, $str] as input.
851
769=cut 852=cut
770 853
771sub log_cb { 854sub log_cb {
772 my ($ctx, $cb) = @_; 855 my ($ctx, $cb) = @_;
773 856
778 my ($ctx, $cb) = @_; 861 my ($ctx, $cb) = @_;
779 862
780 $ctx->[4] = $cb; 863 $ctx->[4] = $cb;
781} 864}
782 865
783=item $ctx->log ($level, $msg[, @params]) 866sub log_to_warn {
867 my ($ctx, $path) = @_;
784 868
785Same as C<AnyEvent::Log::log>, but uses the given context as log context. 869 $ctx->log_cb (sub {
870 warn shift;
871 0
872 });
873}
786 874
787=item $logger = $ctx->logger ($level[, \$enabled]) 875sub log_to_file {
788 876 my ($ctx, $path) = @_;
789Same as C<AnyEvent::Log::logger>, but uses the given context as log
790context.
791
792=cut
793
794*log = \&AnyEvent::Log::_log;
795*logger = \&AnyEvent::Log::_logger;
796
7971;
798
799=back
800
801=head1 EXAMPLES
802
803This section shows some common configurations.
804
805=over 4
806
807=item Setting the global logging level.
808
809Either put PERL_ANYEVENT_VERBOSE=<number> into your environment before
810running your program, or modify the log level of the root context:
811
812 PERL_ANYEVENT_VERBOSE=5 ./myprog
813
814 $AnyEvent::Log::Root->level ("warn");
815
816=item Append all messages to a file instead of sending them to STDERR.
817
818This is affected by the global logging level.
819 877
820 open my $fh, ">>", $path 878 open my $fh, ">>", $path
821 or die "$path: $!"; 879 or die "$path: $!";
822 880
823 $AnyEvent::Log::Default->log_cb (sub { 881 $ctx->log_cb (sub {
824 syswrite $fh, shift; 882 syswrite $fh, shift;
825 0 883 0
826 }); 884 });
885}
886
887sub log_to_path {
888 my ($ctx, $path) = @_;
889
890 $ctx->log_cb (sub {
891 open my $fh, ">>", $path
892 or die "$path: $!";
893
894 syswrite $fh, shift;
895 0
896 });
897}
898
899sub log_to_syslog {
900 my ($ctx, $flags) = @_;
901
902 require Sys::Syslog;
903
904 $ctx->fmt_cb (sub {
905 my $str = $_[3];
906 $str =~ s/\n(?=.)/\n+ /g;
907
908 [$_[2], "($_[1][0]) $str"]
909 });
910
911 $ctx->log_cb (sub {
912 my $lvl = $_[0][0] < 9 ? $_[0][0] : 8;
913
914 Sys::Syslog::syslog ($flags | ($lvl - 1), $_)
915 for split /\n/, $_[0][1];
916
917 0
918 });
919}
920
921=back
922
923=head3 MESSAGE LOGGING
924
925These methods allow you to log messages directly to a context, without
926going via your package context.
927
928=over 4
929
930=item $ctx->log ($level, $msg[, @params])
931
932Same as C<AnyEvent::Log::log>, but uses the given context as log context.
933
934=item $logger = $ctx->logger ($level[, \$enabled])
935
936Same as C<AnyEvent::Log::logger>, but uses the given context as log
937context.
938
939=cut
940
941*log = \&AnyEvent::Log::_log;
942*logger = \&AnyEvent::Log::_logger;
943
944=back
945
946=cut
947
948package AnyEvent::Log;
949
950=head1 CONFIGURATION VIA $ENV{PERL_ANYEVENT_LOG}
951
952Logging can also be configured by setting the environment variable
953C<PERL_ANYEVENT_LOG> (or C<AE_LOG>).
954
955The value consists of one or more logging context specifications separated
956by C<:> or whitespace. Each logging specification in turn starts with a
957context name, followed by C<=>, followed by zero or more comma-separated
958configuration directives, here are some examples:
959
960 # set default logging level
961 filter=warn
962
963 # log to file instead of to stderr
964 log=file=/tmp/mylog
965
966 # log to file in addition to stderr
967 log=+%file:%file=file=/tmp/mylog
968
969 # enable debug log messages, log warnings and above to syslog
970 filter=debug:log=+%warnings:%warnings=warn,syslog=LOG_LOCAL0
971
972 # log trace messages (only) from AnyEvent::Debug to file
973 AnyEvent::Debug=+%trace:%trace=only,trace,file=/tmp/tracelog
974
975A context name in the log specification can be any of the following:
976
977=over 4
978
979=item C<collect>, C<filter>, C<log>
980
981Correspond to the three predefined C<$AnyEvent::Log::COLLECT>,
982C<AnyEvent::Log::FILTER> and C<$AnyEvent::Log::LOG> contexts.
983
984=item C<%name>
985
986Context names starting with a C<%> are anonymous contexts created when the
987name is first mentioned. The difference to package contexts is that by
988default they have no attached slaves.
989
990=item a perl package name
991
992Any other string references the logging context associated with the given
993Perl C<package>. In the unlikely case where you want to specify a package
994context that matches on of the other context name forms, you can add a
995C<::> to the package name to force interpretation as a package.
996
997=back
998
999The configuration specifications can be any number of the following:
1000
1001=over 4
1002
1003=item C<stderr>
1004
1005Configures the context to use Perl's C<warn> function (which typically
1006logs to C<STDERR>). Works like C<log_to_warn>.
1007
1008=item C<file=>I<path>
1009
1010Configures the context to log to a file with the given path. Works like
1011C<log_to_file>.
1012
1013=item C<path=>I<path>
1014
1015Configures the context to log to a file with the given path. Works like
1016C<log_to_path>.
1017
1018=item C<syslog> or C<syslog=>I<expr>
1019
1020Configures the context to log to syslog. If I<expr> is given, then it is
1021evaluated in the L<Sys::Syslog> package, so you could use:
1022
1023 log=syslog=LOG_LOCAL0
1024
1025=item C<nolog>
1026
1027Configures the context to not log anything by itself, which is the
1028default. Same as C<< $ctx->log_cb (undef) >>.
1029
1030=item C<0> or C<off>
1031
1032Sets the logging level of the context ot C<0>, i.e. all messages will be
1033filtered out.
1034
1035=item C<all>
1036
1037Enables all logging levels, i.e. filtering will effectively be switched
1038off (the default).
1039
1040=item C<only>
1041
1042Disables all logging levels, and changes the interpretation of following
1043level specifications to enable the specified level only.
1044
1045Example: only enable debug messages for a context.
1046
1047 context=only,debug
1048
1049=item C<except>
1050
1051Enables all logging levels, and changes the interpretation of following
1052level specifications to disable that level. Rarely used.
1053
1054Example: enable all logging levels except fatal and trace (this is rather
1055nonsensical).
1056
1057 filter=exept,fatal,trace
1058
1059=item C<level>
1060
1061Enables all logging levels, and changes the interpretation of following
1062level specifications to be "that level or any higher priority
1063message". This is the default.
1064
1065Example: log anything at or above warn level.
1066
1067 filter=warn
1068
1069 # or, more verbose
1070 filter=only,level,warn
1071
1072=item C<1>..C<9> or a logging level name (C<error>, C<debug> etc.)
1073
1074A numeric loglevel or the name of a loglevel will be interpreted according
1075to the most recent C<only>, C<except> or C<level> directive. By default,
1076specifying a logging level enables that and any higher priority messages.
1077
1078=item C<+>I<context>
1079
1080Attaches the named context as slave to the context.
1081
1082=item C<+>
1083
1084A line C<+> detaches all contexts, i.e. clears the slave list from the
1085context. Anonymous (C<%name>) contexts have no attached slaves by default,
1086but package contexts have the parent context as slave by default.
1087
1088Example: log messages from My::Module to a file, do not send them to the
1089default log collector.
1090
1091 My::Module=+,file=/tmp/mymodulelog
1092
1093=back
1094
1095Any character can be escaped by prefixing it with a C<\> (backslash), as
1096usual, so to log to a file containing a comma, colon, backslash and some
1097spaces in the filename, you would do this:
1098
1099 PERL_ANYEVENT_LOG='log=file=/some\ \:file\ with\,\ \\-escapes'
1100
1101Since whitespace (which includes newlines) is allowed, it is fine to
1102specify multiple lines in C<PERL_ANYEVENT_LOG>, e.g.:
1103
1104 PERL_ANYEVENT_LOG="
1105 filter=warn
1106 AnyEvent::Debug=+%trace
1107 %trace=only,trace,+log
1108 " myprog
1109
1110Also, in the unlikely case when you want to concatenate specifications,
1111use whitespace as separator, as C<::> will be interpreted as part of a
1112module name, an empty spec with two separators:
1113
1114 PERL_ANYEVENT_LOG="$PERL_ANYEVENT_LOG MyMod=debug"
1115
1116=cut
1117
1118for (my $spec = $ENV{PERL_ANYEVENT_LOG}) {
1119 my %anon;
1120
1121 my $pkg = sub {
1122 $_[0] eq "log" ? $LOG
1123 : $_[0] eq "filter" ? $FILTER
1124 : $_[0] eq "collect" ? $COLLECT
1125 : $_[0] =~ /^%(.+)$/ ? ($anon{$1} ||= ctx undef)
1126 : $_[0] =~ /^(.*?)(?:::)?$/ ? ctx "$1" # egad :/
1127 : die # never reached?
1128 };
1129
1130 /\G[[:space:]]+/gc; # skip initial whitespace
1131
1132 while (/\G((?:[^:=[:space:]]+|::|\\.)+)=/gc) {
1133 my $ctx = $pkg->($1);
1134 my $level = "level";
1135
1136 while (/\G((?:[^,:[:space:]]+|::|\\.)+)/gc) {
1137 for ("$1") {
1138 if ($_ eq "stderr" ) { $ctx->log_to_warn;
1139 } elsif (/^file=(.+)/ ) { $ctx->log_to_file ("$1");
1140 } elsif (/^path=(.+)/ ) { $ctx->log_to_path ("$1");
1141 } elsif (/syslog(?:=(.*))?/ ) { require Sys::Syslog; $ctx->log_to_syslog (eval "package Sys::Syslog; $1");
1142 } elsif ($_ eq "nolog" ) { $ctx->log_cb (undef);
1143 } elsif (/^\+(.+)$/ ) { $ctx->attach ($pkg->("$1"));
1144 } elsif ($_ eq "+" ) { $ctx->slaves;
1145 } elsif ($_ eq "off" or $_ eq "0") { $ctx->level (0);
1146 } elsif ($_ eq "all" ) { $ctx->level ("all");
1147 } elsif ($_ eq "level" ) { $ctx->level ("all"); $level = "level";
1148 } elsif ($_ eq "only" ) { $ctx->level ("off"); $level = "enable";
1149 } elsif ($_ eq "except" ) { $ctx->level ("all"); $level = "disable";
1150 } elsif (/^\d$/ ) { $ctx->$level ($_);
1151 } elsif (exists $STR2LEVEL{$_} ) { $ctx->$level ($_);
1152 } else { die "PERL_ANYEVENT_LOG ($spec): parse error at '$_'\n";
1153 }
1154 }
1155
1156 /\G,/gc or last;
1157 }
1158
1159 /\G[:[:space:]]+/gc or last;
1160 }
1161
1162 /\G[[:space:]]+/gc; # skip trailing whitespace
1163
1164 if (/\G(.+)/g) {
1165 die "PERL_ANYEVENT_LOG ($spec): parse error at '$1'\n";
1166 }
1167}
1168
11691;
1170
1171=head1 EXAMPLES
1172
1173This section shows some common configurations, both as code, and as
1174C<PERL_ANYEVENT_LOG> string.
1175
1176=over 4
1177
1178=item Setting the global logging level.
1179
1180Either put C<PERL_ANYEVENT_VERBOSE=><number> into your environment before
1181running your program, use C<PERL_ANYEVENT_LOG> or modify the log level of
1182the root context at runtime:
1183
1184 PERL_ANYEVENT_VERBOSE=5 ./myprog
1185
1186 PERL_ANYEVENT_LOG=log=warn
1187
1188 $AnyEvent::Log::FILTER->level ("warn");
1189
1190=item Append all messages to a file instead of sending them to STDERR.
1191
1192This is affected by the global logging level.
1193
1194 $AnyEvent::Log::LOG->log_to_file ($path);
1195
1196 PERL_ANYEVENT_LOG=log=file=/some/path
827 1197
828=item Write all messages with priority C<error> and higher to a file. 1198=item Write all messages with priority C<error> and higher to a file.
829 1199
830This writes them only when the global logging level allows it, because 1200This writes them only when the global logging level allows it, because
831it is attached to the default context which is invoked I<after> global 1201it is attached to the default context which is invoked I<after> global
832filtering. 1202filtering.
833 1203
834 open my $fh, ">>", $path 1204 $AnyEvent::Log::FILTER->attach
835 or die "$path: $!"; 1205 new AnyEvent::Log::Ctx log_to_file => $path);
836 1206
837 $AnyEvent::Log::Default->attach (new AnyEvent::Log::Ctx 1207 PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path
838 log_cb => sub { syswrite $fh, shift; 0 });
839 1208
840This writes them regardless of the global logging level, because it is 1209This writes them regardless of the global logging level, because it is
841attached to the toplevel context, which receives all messages I<before> 1210attached to the toplevel context, which receives all messages I<before>
842the global filtering. 1211the global filtering.
843 1212
844 $AnyEvent::Log::Top->attach (new AnyEvent::Log::Ctx 1213 $AnyEvent::Log::COLLECT->attach (
845 log_cb => sub { syswrite $fh, shift; 0 }); 1214 new AnyEvent::Log::Ctx log_to_file => $path);
846 1215
1216 PERL_ANYEVENT_LOG=%filelogger=file=/some/path:collect=+%filelogger
1217
847In both cases, messages are still written to STDOUT. 1218In both cases, messages are still written to STDERR.
848 1219
849=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s). 1220=item Write trace messages (only) from L<AnyEvent::Debug> to the default logging target(s).
850 1221
851Attach the CyAnyEvent::Log::Default> context to the C<AnyEvent::Debug> 1222Attach the C<$AnyEvent::Log::LOG> context to the C<AnyEvent::Debug>
852context and increase the C<AnyEvent::Debug> logging level - this simply
853circumvents the global filtering for trace messages. 1223context - this simply circumvents the global filtering for trace messages.
854 1224
855 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx; 1225 my $debug = AnyEvent::Debug->AnyEvent::Log::ctx;
856 $debug->attach ($AnyEvent::Log::Default); 1226 $debug->attach ($AnyEvent::Log::LOG);
857 $debug->levels ("trace"); # not "level"!
858 1227
859This of course works for any package. 1228 PERL_ANYEVENT_LOG=AnyEvent::Debug=+log
1229
1230This of course works for any package, not just L<AnyEvent::Debug>, but
1231assumes the log level for AnyEvent::Debug hasn't been changed from the
1232default.
860 1233
861=back 1234=back
862 1235
863=head1 AUTHOR 1236=head1 AUTHOR
864 1237
865 Marc Lehmann <schmorp@schmorp.de> 1238 Marc Lehmann <schmorp@schmorp.de>
866 http://home.schmorp.de/ 1239 http://home.schmorp.de/
867 1240
868=cut 1241=cut
1242

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines