… | |
… | |
249 | } |
249 | } |
250 | |
250 | |
251 | join "", @res |
251 | join "", @res |
252 | } |
252 | } |
253 | |
253 | |
|
|
254 | sub fatal_exit() { |
|
|
255 | exit 1; |
|
|
256 | } |
|
|
257 | |
254 | sub _log { |
258 | sub _log { |
255 | my ($ctx, $level, $format, @args) = @_; |
259 | my ($ctx, $level, $format, @args) = @_; |
256 | |
260 | |
257 | $level = $level > 0 && $level <= 9 |
261 | $level = $level > 0 && $level <= 9 |
258 | ? $level+0 |
262 | ? $level+0 |
… | |
… | |
291 | } |
295 | } |
292 | } |
296 | } |
293 | } |
297 | } |
294 | while $ctx = pop @ctx; |
298 | while $ctx = pop @ctx; |
295 | |
299 | |
296 | exit 1 if $level <= 1; |
300 | fatal_exit if $level <= 1; |
297 | |
301 | |
298 | $success |
302 | $success |
299 | } |
303 | } |
300 | |
304 | |
301 | sub log($$;@) { |
305 | sub log($$;@) { |
302 | _log |
306 | _log |
303 | $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], |
307 | $CTX{ (caller)[0] } ||= _pkg_ctx +(caller)[0], |
304 | @_; |
308 | @_; |
305 | } |
309 | } |
306 | |
310 | |
307 | *AnyEvent::log = *AE::log = \&log; |
|
|
308 | |
|
|
309 | =item $logger = AnyEvent::Log::logger $level[, \$enabled] |
311 | =item $logger = AnyEvent::Log::logger $level[, \$enabled] |
310 | |
312 | |
311 | Creates a code reference that, when called, acts as if the |
313 | Creates a code reference that, when called, acts as if the |
312 | C<AnyEvent::Log::log> function was called at this point with the given |
314 | C<AnyEvent::Log::log> function was called at this point with the given |
313 | level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with |
315 | level. C<$logger> is passed a C<$msg> and optional C<@args>, just as with |
… | |
… | |
377 | |
379 | |
378 | $LOGGER{$logger+0} = $logger; |
380 | $LOGGER{$logger+0} = $logger; |
379 | |
381 | |
380 | _reassess $logger+0; |
382 | _reassess $logger+0; |
381 | |
383 | |
382 | require AnyEvent::Util; |
384 | require AnyEvent::Util unless $AnyEvent::Util::VERSION; |
383 | my $guard = AnyEvent::Util::guard (sub { |
385 | my $guard = AnyEvent::Util::guard (sub { |
384 | # "clean up" |
386 | # "clean up" |
385 | delete $LOGGER{$logger+0}; |
387 | delete $LOGGER{$logger+0}; |
386 | }); |
388 | }); |
387 | |
389 | |
… | |
… | |
540 | This can be used to implement config-file (re-)loading: before loading a |
542 | This can be used to implement config-file (re-)loading: before loading a |
541 | configuration, reset all contexts. |
543 | configuration, reset all contexts. |
542 | |
544 | |
543 | =cut |
545 | =cut |
544 | |
546 | |
|
|
547 | our $ORIG_VERBOSE = $AnyEvent::VERBOSE; |
|
|
548 | $AnyEvent::VERBOSE = 9; |
|
|
549 | |
545 | sub reset { |
550 | sub reset { |
546 | # hard to kill complex data structures |
551 | # hard to kill complex data structures |
547 | # we "recreate" all package loggers and reset the hierarchy |
552 | # we "recreate" all package loggers and reset the hierarchy |
548 | while (my ($k, $v) = each %CTX) { |
553 | while (my ($k, $v) = each %CTX) { |
549 | @$v = ($k, (1 << 10) - 1 - 1, { }); |
554 | @$v = ($k, (1 << 10) - 1 - 1, { }); |
… | |
… | |
558 | $LOG->title ('$AnyEvent::Log::LOG'); |
563 | $LOG->title ('$AnyEvent::Log::LOG'); |
559 | $LOG->log_to_warn; |
564 | $LOG->log_to_warn; |
560 | |
565 | |
561 | $FILTER->slaves ($LOG); |
566 | $FILTER->slaves ($LOG); |
562 | $FILTER->title ('$AnyEvent::Log::FILTER'); |
567 | $FILTER->title ('$AnyEvent::Log::FILTER'); |
563 | $FILTER->level ($AnyEvent::VERBOSE); |
568 | $FILTER->level ($ORIG_VERBOSE); |
564 | |
569 | |
565 | $COLLECT->slaves ($FILTER); |
570 | $COLLECT->slaves ($FILTER); |
566 | $COLLECT->title ('$AnyEvent::Log::COLLECT'); |
571 | $COLLECT->title ('$AnyEvent::Log::COLLECT'); |
567 | |
572 | |
568 | _reassess; |
573 | _reassess; |
569 | } |
574 | } |
|
|
575 | |
|
|
576 | # override AE::log/logger |
|
|
577 | *AnyEvent::log = *AE::log = \&log; |
|
|
578 | *AnyEvent::logger = *AE::logger = \&logger; |
|
|
579 | |
|
|
580 | # convert AnyEvent loggers to AnyEvent::Log loggers |
|
|
581 | $_->[0] = ctx $_->[0] # convert "pkg" to "ctx" |
|
|
582 | for values %LOGGER; |
570 | |
583 | |
571 | # create the default logger contexts |
584 | # create the default logger contexts |
572 | $LOG = ctx undef; |
585 | $LOG = ctx undef; |
573 | $FILTER = ctx undef; |
586 | $FILTER = ctx undef; |
574 | $COLLECT = ctx undef; |
587 | $COLLECT = ctx undef; |
… | |
… | |
1237 | |
1250 | |
1238 | This writes them only when the global logging level allows it, because |
1251 | This writes them only when the global logging level allows it, because |
1239 | it is attached to the default context which is invoked I<after> global |
1252 | it is attached to the default context which is invoked I<after> global |
1240 | filtering. |
1253 | filtering. |
1241 | |
1254 | |
1242 | $AnyEvent::Log::FILTER->attach |
1255 | $AnyEvent::Log::FILTER->attach ( |
1243 | new AnyEvent::Log::Ctx log_to_file => $path); |
1256 | new AnyEvent::Log::Ctx log_to_file => $path); |
1244 | |
1257 | |
1245 | PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path |
1258 | PERL_ANYEVENT_LOG=filter=+%filelogger:%filelogger=file=/some/path |
1246 | |
1259 | |
1247 | This writes them regardless of the global logging level, because it is |
1260 | This writes them regardless of the global logging level, because it is |