ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Debug.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Debug.pm (file contents):
Revision 1.31 by root, Thu Aug 25 04:16:23 2011 UTC vs.
Revision 1.40 by root, Mon Apr 9 02:25:48 2012 UTC

24 24
25=cut 25=cut
26 26
27package AnyEvent::Debug; 27package AnyEvent::Debug;
28 28
29use B ();
29use Carp (); 30use Carp ();
30use Errno (); 31use Errno ();
31 32
32use AnyEvent (); BEGIN { AnyEvent::common_sense } 33use AnyEvent (); BEGIN { AnyEvent::common_sense }
33use AnyEvent::Util (); 34use AnyEvent::Util ();
281A level of C<2> does everything that level C<1> does, but also stores a 282A level of C<2> does everything that level C<1> does, but also stores a
282full backtrace of the location the watcher was created, which slows down 283full backtrace of the location the watcher was created, which slows down
283watcher creation considerably. 284watcher creation considerably.
284 285
285Every wrapped watcher will be linked into C<%AnyEvent::Debug::Wrapped>, 286Every wrapped watcher will be linked into C<%AnyEvent::Debug::Wrapped>,
286with its address as key. The C<wl> command in the debug shell cna be used 287with its address as key. The C<wl> command in the debug shell can be used
287to list watchers. 288to list watchers.
288 289
289Instrumenting can increase the size of each watcher multiple times, and, 290Instrumenting can increase the size of each watcher multiple times, and,
290especially when backtraces are involved, also slows down watcher creation 291especially when backtraces are involved, also slows down watcher creation
291a lot. 292a 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
373sub cb2str($) { 374sub 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
392sub sv2str($) { 395sub 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
410Creates a backtrace (actually an AnyEvent::Debug::Backtrace object 413Creates a backtrace (actually an AnyEvent::Debug::Backtrace object
411that you can stringify), not unlike the Carp module would. Unlike the 414that you can stringify), not unlike the Carp module would. Unlike the
412Carp module it resolves some references (euch as callbacks) to more 415Carp module it resolves some references (such as callbacks) to more
413user-friendly strings, has a more succinct output format and most 416user-friendly strings, has a more succinct output format and most
414importantly: doesn't leak memory like hell. 417importantly: doesn't leak memory like hell.
415 418
416The reason it creates an object is to save time, as formatting can be 419The reason it creates an object is to save time, as formatting can be
417done at a later time. Still, creating a backtrace is a relatively slow 420done 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] }
700use overload 709use overload
701 '""' => \&as_string, 710 '""' => \&as_string,
702 fallback => 1, 711 fallback => 1,
703; 712;
704 713
7051;
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
7211
722

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines