… | |
… | |
20 | $tracer->("i am here") if $trace; |
20 | $tracer->("i am here") if $trace; |
21 | $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; |
21 | $tracer->(sub { "lots of data: " . Dumper $self }) if $trace; |
22 | |
22 | |
23 | # configuration |
23 | # configuration |
24 | |
24 | |
25 | # set logging for this package to maximum |
25 | # set logging for this package to errors and higher only |
26 | AnyEvent::Log::ctx->level ("all"); |
26 | AnyEvent::Log::ctx->level ("error"); |
27 | |
27 | |
28 | # set logging globally to anything below debug |
28 | # set logging globally to anything below debug |
29 | (AnyEvent::Log::ctx "")->level ("notice"); |
29 | $AnyEvent::Log::Root->level ("notice"); |
30 | |
30 | |
31 | # see also EXAMPLES, below |
31 | # see also EXAMPLES, below |
32 | |
|
|
33 | # disable logging for package "AnyEvent" and all packages below it |
|
|
34 | AnyEvent->AnyEvent::Log::ctx->level (0); |
|
|
35 | |
|
|
36 | # log everything below debug to a file, for the whole program |
|
|
37 | my $ctx = AnyEvent::Log::ctx; |
|
|
38 | $ctx->log_cb (sub { print FILE shift; 0 }); |
|
|
39 | (AnyEvent::Log::ctx "")->add ($ctx); |
|
|
40 | |
32 | |
41 | =head1 DESCRIPTION |
33 | =head1 DESCRIPTION |
42 | |
34 | |
43 | This module implements a relatively simple "logging framework". It doesn't |
35 | This module implements a relatively simple "logging framework". It doesn't |
44 | attempt to be "the" logging solution or even "a" logging solution for |
36 | attempt to be "the" logging solution or even "a" logging solution for |
… | |
… | |
280 | # and later in your program |
272 | # and later in your program |
281 | $debug_log->("yo, stuff here") if $debug; |
273 | $debug_log->("yo, stuff here") if $debug; |
282 | |
274 | |
283 | $debug and $debug_log->("123"); |
275 | $debug and $debug_log->("123"); |
284 | |
276 | |
285 | Note: currently the enabled var is always true - that will be fixed in a |
|
|
286 | future version :) |
|
|
287 | |
|
|
288 | =cut |
277 | =cut |
289 | |
278 | |
290 | our %LOGGER; |
279 | our %LOGGER; |
291 | |
280 | |
292 | # re-assess logging status for all loggers |
281 | # re-assess logging status for all loggers |
293 | sub _reassess { |
282 | sub _reassess { |
|
|
283 | local $SIG{__DIE__}; |
|
|
284 | my $die = sub { die }; |
|
|
285 | |
294 | for (@_ ? $LOGGER{$_[0]} : values %LOGGER) { |
286 | for (@_ ? $LOGGER{$_[0]} : values %LOGGER) { |
295 | my ($ctx, $level, $renabled) = @$_; |
287 | my ($ctx, $level, $renabled) = @$_; |
296 | |
288 | |
297 | # to detect whether a message would be logged, we # actually |
289 | # to detect whether a message would be logged, we actually |
298 | # try to log one and die. this isn't fast, but we can be |
290 | # try to log one and die. this isn't fast, but we can be |
299 | # sure that the logging decision is correct :) |
291 | # sure that the logging decision is correct :) |
300 | |
292 | |
301 | $$renabled = !eval { |
293 | $$renabled = !eval { |
302 | local $SIG{__DIE__}; |
|
|
303 | |
|
|
304 | _log $ctx, $level, sub { die }; |
294 | _log $ctx, $level, $die; |
305 | |
295 | |
306 | 1 |
296 | 1 |
307 | }; |
297 | }; |
308 | |
|
|
309 | $$renabled = 1; # TODO |
|
|
310 | } |
298 | } |
311 | } |
299 | } |
312 | |
300 | |
313 | sub _logger($;$) { |
301 | sub _logger { |
314 | my ($ctx, $level, $renabled) = @_; |
302 | my ($ctx, $level, $renabled) = @_; |
315 | |
|
|
316 | $renabled ||= \my $enabled; |
|
|
317 | |
303 | |
318 | $$renabled = 1; |
304 | $$renabled = 1; |
319 | |
305 | |
320 | my $logger = [$ctx, $level, $renabled]; |
306 | my $logger = [$ctx, $level, $renabled]; |
321 | |
307 | |
… | |
… | |
393 | All other (anonymous) contexts have no parents and an empty title by |
379 | All other (anonymous) contexts have no parents and an empty title by |
394 | default. |
380 | default. |
395 | |
381 | |
396 | When the module is loaded it creates the default context called |
382 | When the module is loaded it creates the default context called |
397 | C<AnyEvent::Log::Default> (also stored in C<$AnyEvent::Log::Default>), |
383 | C<AnyEvent::Log::Default> (also stored in C<$AnyEvent::Log::Default>), |
398 | which simply logs everything to STDERR and doesn't propagate anything |
384 | which simply logs everything via C<warn> and doesn't propagate anything |
399 | anywhere by default. The purpose of the default context is to provide |
385 | anywhere by default. The purpose of the default context is to provide |
400 | a convenient place to override the global logging target or to attach |
386 | a convenient place to override the global logging target or to attach |
401 | additional log targets. It's not meant for filtering. |
387 | additional log targets. It's not meant for filtering. |
402 | |
388 | |
403 | It then creates the root context called C<AnyEvent::Log::Root> (also |
389 | It then creates the root context called C<AnyEvent::Log::Root> (also |
… | |
… | |
417 | C<AE::Log::Top>. |
403 | C<AE::Log::Top>. |
418 | |
404 | |
419 | The effect of all this is that log messages, by default, wander up |
405 | The effect of all this is that log messages, by default, wander up |
420 | to the root context where log messages with lower priority then |
406 | to the root context where log messages with lower priority then |
421 | C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered away and then to the |
407 | C<$ENV{PERL_ANYEVENT_VERBOSE}> will be filtered away and then to the |
422 | AnyEvent::Log::Default context to be logged to STDERR. |
408 | AnyEvent::Log::Default context to be passed to C<warn>. |
423 | |
409 | |
424 | Splitting the top level context into three contexts makes it easy to set |
410 | Splitting the top level context into three contexts makes it easy to set |
425 | a global logging level (by modifying the root context), but still allow |
411 | a global logging level (by modifying the root context), but still allow |
426 | other contexts to log, for example, their debug and trace messages to the |
412 | other contexts to log, for example, their debug and trace messages to the |
427 | default target despite the global logging level, or to attach additional |
413 | default target despite the global logging level, or to attach additional |
428 | log targets that log messages, regardless of the global logging level. |
414 | log targets that log messages, regardless of the global logging level. |
429 | |
415 | |
430 | It also makes it easy to replace the default STDERR-logger by something |
416 | It also makes it easy to replace the default warn-logger by something that |
431 | that logs to a file, or to attach additional logging targets. |
417 | logs to a file, or to attach additional logging targets. |
432 | |
418 | |
433 | =head2 CREATING/FINDING/DESTROYING CONTEXTS |
419 | =head2 CREATING/FINDING/DESTROYING CONTEXTS |
434 | |
420 | |
435 | =over 4 |
421 | =over 4 |
436 | |
422 | |
… | |
… | |
458 | : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" |
444 | : bless [undef, (1 << 10) - 1 - 1], "AnyEvent::Log::Ctx" |
459 | } |
445 | } |
460 | |
446 | |
461 | =item AnyEvent::Log::reset |
447 | =item AnyEvent::Log::reset |
462 | |
448 | |
463 | Deletes all contexts and recreates the default hierarchy, i.e. resets the |
449 | Resets all package contexts and recreates the default hierarchy if |
464 | logging subsystem to defaults. |
450 | necessary, i.e. resets the logging subsystem to defaults, as much as |
|
|
451 | possible. This process keeps references to contexts held by other parts of |
|
|
452 | the program intact. |
465 | |
453 | |
466 | This can be used to implement config-file (re-)loading: before loading a |
454 | This can be used to implement config-file (re-)loading: before loading a |
467 | configuration, reset all contexts. |
455 | configuration, reset all contexts. |
468 | |
456 | |
469 | =cut |
457 | =cut |
470 | |
458 | |
471 | sub reset { |
459 | sub reset { |
472 | @$_ = () for values %CTX; # just to be sure - to kill circular logging dependencies |
460 | # hard to kill complex data structures |
473 | %CTX = (); |
461 | # we recreate all package loggers and reset the hierarchy |
|
|
462 | while (my ($k, $v) = each %CTX) { |
|
|
463 | @$v = ($k, (1 << 10) - 1 - 1, { }); |
474 | |
464 | |
475 | my $default = ctx undef; |
465 | my $pkg = $k =~ /^(.+)::/ ? $1 : "AE::Log::Top"; |
|
|
466 | $v->attach ($CTX{$pkg}); |
|
|
467 | } |
|
|
468 | |
|
|
469 | $AnyEvent::Log::Default->parents; |
476 | $default->title ("AnyEvent::Log::Default"); |
470 | $AnyEvent::Log::Default->title ("AnyEvent::Log::Default"); |
477 | $default->log_cb (sub { |
471 | $AnyEvent::Log::Default->log_cb (sub { |
478 | print STDERR shift; |
472 | warn shift; |
479 | 0 |
473 | 0 |
480 | }); |
474 | }); |
481 | $AnyEvent::Log::Default = $CTX{"AnyEvent::Log::Default"} = $CTX{"AE::Log::Default"} = $default; |
475 | $CTX{"AnyEvent::Log::Default"} = $CTX{"AE::Log::Default"} = $AnyEvent::Log::Default; |
482 | |
476 | |
483 | my $root = ctx undef; |
477 | $AnyEvent::Log::Root->parents ($AnyEvent::Log::Default); |
484 | $root->title ("AnyEvent::Log::Root"); |
478 | $AnyEvent::Log::Root->title ("AnyEvent::Log::Root"); |
485 | $root->level ($AnyEvent::VERBOSE); |
479 | $AnyEvent::Log::Root->level ($AnyEvent::VERBOSE); |
486 | $root->attach ($default); |
|
|
487 | $AnyEvent::Log::Root = $CTX{"AnyEvent::Log::Root"} = $CTX{"AE::Log::Root"} = $root; |
480 | $CTX{"AnyEvent::Log::Root"} = $CTX{"AE::Log::Root"} = $AnyEvent::Log::Root; |
488 | |
481 | |
489 | my $top = ctx undef; |
482 | $AnyEvent::Log::Top->parents ($AnyEvent::Log::Root); |
490 | $top->title ("AnyEvent::Log::Top"); |
483 | $AnyEvent::Log::Top->title ("AnyEvent::Log::Top"); |
491 | $top->attach ($root); |
|
|
492 | $AnyEvent::Log::Top = $CTX{"AnyEvent::Log::Top"} = $CTX{"AE::Log::Top"} = $top; |
484 | $CTX{"AnyEvent::Log::Top"} = $CTX{"AE::Log::Top"} = $AnyEvent::Log::Top; |
|
|
485 | |
|
|
486 | _reassess; |
493 | } |
487 | } |
|
|
488 | |
|
|
489 | # create the default logger contexts |
|
|
490 | $AnyEvent::Log::Default = ctx undef; |
|
|
491 | $AnyEvent::Log::Root = ctx undef; |
|
|
492 | $AnyEvent::Log::Top = ctx undef; |
494 | |
493 | |
495 | AnyEvent::Log::reset; |
494 | AnyEvent::Log::reset; |
496 | |
495 | |
497 | # hello, CPAN, please catch me |
496 | # hello, CPAN, please catch me |
498 | package AnyEvent::Log::Default; |
497 | package AnyEvent::Log::Default; |