… | |
… | |
24 | |
24 | |
25 | =cut |
25 | =cut |
26 | |
26 | |
27 | package AnyEvent::Debug; |
27 | package AnyEvent::Debug; |
28 | |
28 | |
|
|
29 | use B (); |
29 | use Carp (); |
30 | use Carp (); |
30 | use Errno (); |
31 | use Errno (); |
31 | |
32 | |
32 | use AnyEvent (); BEGIN { AnyEvent::common_sense } |
33 | use AnyEvent (); BEGIN { AnyEvent::common_sense } |
33 | use AnyEvent::Util (); |
34 | use AnyEvent::Util (); |
… | |
… | |
281 | A level of C<2> does everything that level C<1> does, but also stores a |
282 | A level of C<2> does everything that level C<1> does, but also stores a |
282 | full backtrace of the location the watcher was created, which slows down |
283 | full backtrace of the location the watcher was created, which slows down |
283 | watcher creation considerably. |
284 | watcher creation considerably. |
284 | |
285 | |
285 | Every wrapped watcher will be linked into C<%AnyEvent::Debug::Wrapped>, |
286 | Every wrapped watcher will be linked into C<%AnyEvent::Debug::Wrapped>, |
286 | with its address as key. The C<wl> command in the debug shell cna be used |
287 | with its address as key. The C<wl> command in the debug shell can be used |
287 | to list watchers. |
288 | to list watchers. |
288 | |
289 | |
289 | Instrumenting can increase the size of each watcher multiple times, and, |
290 | Instrumenting can increase the size of each watcher multiple times, and, |
290 | especially when backtraces are involved, also slows down watcher creation |
291 | especially when backtraces are involved, also slows down watcher creation |
291 | a lot. |
292 | a lot. |
… | |
… | |
320 | undef $POST_DETECT; |
321 | undef $POST_DETECT; |
321 | return unless $WRAP_LEVEL; |
322 | return unless $WRAP_LEVEL; |
322 | |
323 | |
323 | (my $level, $WRAP_LEVEL) = ($WRAP_LEVEL, undef); |
324 | (my $level, $WRAP_LEVEL) = ($WRAP_LEVEL, undef); |
324 | |
325 | |
325 | require AnyEvent::Strict; |
326 | require AnyEvent::Strict unless $AnyEvent::Strict::VERSION; |
326 | |
327 | |
327 | AnyEvent::post_detect { # make sure we run after AnyEvent::Strict |
328 | AnyEvent::post_detect { # make sure we run after AnyEvent::Strict |
328 | wrap ($level); |
329 | wrap ($level); |
329 | }; |
330 | }; |
330 | }; |
331 | }; |
… | |
… | |
371 | =cut |
372 | =cut |
372 | |
373 | |
373 | sub cb2str($) { |
374 | sub cb2str($) { |
374 | my $cb = shift; |
375 | my $cb = shift; |
375 | |
376 | |
376 | require B; |
|
|
377 | |
|
|
378 | "CODE" eq ref $cb |
377 | "CODE" eq ref $cb |
379 | or return "$cb"; |
378 | or return "$cb"; |
380 | |
379 | |
|
|
380 | eval { |
381 | my $cv = B::svref_2object ($cb); |
381 | my $cv = B::svref_2object ($cb); |
382 | |
382 | |
383 | my $gv = $cv->GV |
383 | my $gv = $cv->GV |
384 | or return "$cb"; |
384 | or return "$cb"; |
385 | |
385 | |
|
|
386 | my $name = $gv->NAME; |
|
|
387 | |
386 | return (AnyEvent::Debug::path2mod $gv->FILE) . ":" . $gv->LINE |
388 | return (AnyEvent::Debug::path2mod $gv->FILE) . ":" . $gv->LINE |
387 | if $gv->NAME eq "__ANON__"; |
389 | if $name eq "__ANON__"; |
388 | |
390 | |
389 | return $gv->STASH->NAME . "::" . $gv->NAME; |
391 | $gv->STASH->NAME . "::" . $name; |
|
|
392 | } || "$cb" |
390 | } |
393 | } |
391 | |
394 | |
392 | sub sv2str($) { |
395 | sub sv2str($) { |
393 | if (ref $_[0]) { |
396 | if (ref $_[0]) { |
394 | if (ref $_[0] eq "CODE") { |
397 | if (ref $_[0] eq "CODE") { |
… | |
… | |
407 | |
410 | |
408 | =item AnyEvent::Debug::backtrace [$skip] |
411 | =item AnyEvent::Debug::backtrace [$skip] |
409 | |
412 | |
410 | Creates a backtrace (actually an AnyEvent::Debug::Backtrace object |
413 | Creates a backtrace (actually an AnyEvent::Debug::Backtrace object |
411 | that you can stringify), not unlike the Carp module would. Unlike the |
414 | that you can stringify), not unlike the Carp module would. Unlike the |
412 | Carp module it resolves some references (euch as callbacks) to more |
415 | Carp module it resolves some references (such as callbacks) to more |
413 | user-friendly strings, has a more succinct output format and most |
416 | user-friendly strings, has a more succinct output format and most |
414 | importantly: doesn't leak memory like hell. |
417 | importantly: doesn't leak memory like hell. |
415 | |
418 | |
416 | The reason it creates an object is to save time, as formatting can be |
419 | The reason it creates an object is to save time, as formatting can be |
417 | done at a later time. Still, creating a backtrace is a relatively slow |
420 | done at a later time. Still, creating a backtrace is a relatively slow |
… | |
… | |
499 | if defined $^S; |
502 | if defined $^S; |
500 | }; |
503 | }; |
501 | &$cb; |
504 | &$cb; |
502 | }; |
505 | }; |
503 | if ($@) { |
506 | if ($@) { |
|
|
507 | my $err = "$@"; |
504 | push @{ $w->{error} }, [AE::now, "$@"] |
508 | push @{ $w->{error} }, [AE::now, $err] |
505 | if @{ $w->{error} } < 10; |
509 | if @{ $w->{error} } < 10; |
506 | AE::log die => "($w) $@" |
510 | AE::log die => "($w) $err" |
507 | or warn "($w) $@"; |
511 | or warn "($w) $err"; |
508 | } |
512 | } |
509 | $TRACE_LOGGER->("leave $w") if $TRACE_ENABLED && $t; |
513 | $TRACE_LOGGER->("leave $w") if $TRACE_ENABLED && $t; |
510 | }; |
514 | }; |
511 | |
515 | |
512 | $self = bless { |
516 | $self = bless { |
… | |
… | |
687 | my ($rpath, $line, $sub) = @$_; |
691 | my ($rpath, $line, $sub) = @$_; |
688 | |
692 | |
689 | $rpath = (AnyEvent::Debug::path2mod $$rpath) . " line $line"; |
693 | $rpath = (AnyEvent::Debug::path2mod $$rpath) . " line $line"; |
690 | $modlen = length $rpath if $modlen < length $rpath; |
694 | $modlen = length $rpath if $modlen < length $rpath; |
691 | |
695 | |
|
|
696 | $sub =~ s/\r/\\r/g; |
|
|
697 | $sub =~ s/\n/\\n/g; |
|
|
698 | $sub =~ s/([\x00-\x1f\x7e-\xff])/sprintf "\\x%02x", ord $1/ge; |
|
|
699 | $sub =~ s/([^\x20-\x7e])/sprintf "\\x{%x}", ord $1/ge; |
|
|
700 | |
692 | push @bt, [$rpath, $sub]; |
701 | push @bt, [$rpath, $sub]; |
693 | } |
702 | } |
694 | |
703 | |
695 | join "", |
704 | join "", |
696 | map { sprintf "%*s %s\n", -$modlen, $_->[0], $_->[1] } |
705 | map { sprintf "%*s %s\n", -$modlen, $_->[0], $_->[1] } |
… | |
… | |
700 | use overload |
709 | use overload |
701 | '""' => \&as_string, |
710 | '""' => \&as_string, |
702 | fallback => 1, |
711 | fallback => 1, |
703 | ; |
712 | ; |
704 | |
713 | |
705 | 1; |
|
|
706 | |
|
|
707 | =head1 AUTHOR |
714 | =head1 AUTHOR |
708 | |
715 | |
709 | Marc Lehmann <schmorp@schmorp.de> |
716 | Marc Lehmann <schmorp@schmorp.de> |
710 | http://home.schmorp.de/ |
717 | http://anyevent.schmorp.de |
711 | |
718 | |
712 | =cut |
719 | =cut |
713 | |
720 | |
|
|
721 | 1 |
|
|
722 | |