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.15 by root, Mon Aug 15 12:56:53 2011 UTC vs.
Revision 1.16 by root, Mon Aug 15 18:58:29 2011 UTC

… …
24 24
25=cut 25=cut
26 26
27package AnyEvent::Debug; 27package AnyEvent::Debug;
28 28
29use Carp ();
29use Errno (); 30use Errno ();
30use POSIX (); 31use POSIX ();
31 32
32use AnyEvent (); BEGIN { AnyEvent::common_sense } 33use AnyEvent (); BEGIN { AnyEvent::common_sense }
33use AnyEvent::Util (); 34use AnyEvent::Util ();
… …
227 228
228sub wrap(;$) { 229sub wrap(;$) {
229 my $PREV_LEVEL = $WRAP_LEVEL; 230 my $PREV_LEVEL = $WRAP_LEVEL;
230 $WRAP_LEVEL = @_ ? 0+shift : $WRAP_LEVEL ? 0 : 1; 231 $WRAP_LEVEL = @_ ? 0+shift : $WRAP_LEVEL ? 0 : 1;
231 232
232 if (defined $AnyEvent::MODEL) { 233 if ($AnyEvent::MODEL) {
233 unless (defined $PREV_LEVEL) {
234 AnyEvent::Debug::Wrapped::_init ();
235 }
236
237 if ($WRAP_LEVEL && !$PREV_LEVEL) { 234 if ($WRAP_LEVEL && !$PREV_LEVEL) {
238 AnyEvent::_isa_hook 1 => "AnyEvent::Debug::Wrap", 1; 235 AnyEvent::_isa_hook 1 => "AnyEvent::Debug::Wrap", 1;
239 AnyEvent::Debug::Wrap::_reset (); 236 AnyEvent::Debug::Wrap::_reset ();
240 } elsif (!$WRAP_LEVEL && $PREV_LEVEL) { 237 } elsif (!$WRAP_LEVEL && $PREV_LEVEL) {
241 AnyEvent::_isa_hook 0 => undef; 238 AnyEvent::_isa_hook 0 => undef;
… …
289 286
290Using various gambits, tries to convert a callback (e.g. a code reference) 287Using various gambits, tries to convert a callback (e.g. a code reference)
291into a more useful string. 288into a more useful string.
292 289
293Very useful if you debug a program and have some callback, but you want to 290Very useful if you debug a program and have some callback, but you want to
294know where in the program the callbakc is actually defined. 291know where in the program the callback is actually defined.
295 292
296=cut 293=cut
297 294
298sub cb2str($) { 295sub cb2str($) {
299 my $cb = shift; 296 my $cb = shift;
… …
310 307
311 return (AnyEvent::Debug::path2mod $gv->FILE) . ":" . $gv->LINE 308 return (AnyEvent::Debug::path2mod $gv->FILE) . ":" . $gv->LINE
312 if $gv->NAME eq "__ANON__"; 309 if $gv->NAME eq "__ANON__";
313 310
314 return $gv->STASH->NAME . "::" . $gv->NAME; 311 return $gv->STASH->NAME . "::" . $gv->NAME;
312}
313
314sub sv2str($) {
315 if (ref $_[0]) {
316 if (ref $_[0] eq "CODE") {
317 return "$_[0]=" . cb2str $_[0];
318 } else {
319 return "$_[0]";
320 }
321 } else {
322 for ("\'$_[0]\'") { # make copy
323 substr $_, $Carp::MaxArgLen, length, "'..."
324 if length > $Carp::MaxArgLen;
325 return $_;
326 }
327 }
328}
329
330=item AnyEvent::Debug::backtrace
331
332Creates a backtrace (actually an AnyEvent::Debug::Backtrace object
333that you can stringify), not unlike the Carp module would. Unlike the
334Carp module it resolves some references (euch as callbacks) to more
335user-friendly strings, has a more succinct output format and most
336importantly: doesn't leak memory like hell.
337
338The reason it creates an object is to save time, as formatting can be
339done at a later time. Still, creating a backtrace is a relatively slow
340operation.
341
342=cut
343
344our %PATHCACHE; # purely to save memory
345
346sub backtrace() {
347 my (@bt, $w, @c);
348 my ($modlen, $sub);
349
350 for (;;) {
351 # 0 1 2 3 4 5 6 7 8 9 10
352 # ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash)
353 package DB;
354 @c = caller $w++
355 or last;
356 package AnyEvent::Debug; # no block for speed reasons
357
358 if ($c[7]) {
359 $sub = "require $c[6]";
360 } elsif (defined $c[6]) {
361 $sub = "eval \"\"";
362 } else {
363 $sub = ($c[4] ? "" : "&") . $c[3];
364
365 $sub .= "("
366 . (join ",",
367 map sv2str $DB::args[$_],
368 0 .. (@DB::args < $Carp::MaxArgNums ? @DB::args : $Carp::MaxArgNums) - 1)
369 . ")"
370 if $c[4];
371 }
372
373 push @bt, [\($PATHCACHE{$c[1]} ||= $c[1]), $c[2], $sub];
374 }
375
376 @DB::args = ();
377
378 bless \@bt, "AnyEvent::Debug::Backtrace"
315} 379}
316 380
317# Format Time, not public - yet? 381# Format Time, not public - yet?
318sub ft($) { 382sub ft($) {
319 my $t = shift; 383 my $t = shift;
… …
343 $w = 0; 407 $w = 0;
344 do { 408 do {
345 ($pkg, $file, $line) = caller $w++; 409 ($pkg, $file, $line) = caller $w++;
346 } while $pkg =~ /^(?:AE|AnyEvent::(?:Socket|Handle|Util|Debug|Strict|Base|CondVar|CondVar::Base|Impl::.*))$/; 410 } while $pkg =~ /^(?:AE|AnyEvent::(?:Socket|Handle|Util|Debug|Strict|Base|CondVar|CondVar::Base|Impl::.*))$/;
347 411
348 $sub = (caller $w++)[3]; 412 $sub = (caller $w)[3];
349 413
350 my $cb = $arg{cb}; 414 my $cb = $arg{cb};
351 $arg{cb} = sub { 415 $arg{cb} = sub {
352 ++$w->{called}; 416 ++$w->{called};
353 417
… …
355 unless $TRACE_LEVEL; 419 unless $TRACE_LEVEL;
356 420
357 local $TRACE_CUR = "$w"; 421 local $TRACE_CUR = "$w";
358 print AnyEvent::Debug::ft AE::now, " enter $TRACE_CUR\n" if $TRACE_LEVEL; 422 print AnyEvent::Debug::ft AE::now, " enter $TRACE_CUR\n" if $TRACE_LEVEL;
359 eval { 423 eval {
360 local $SIG{__DIE__} = sub { die Carp::longmess "$_[0]Backtrace starting" }; 424 local $SIG{__DIE__} = sub { die $_[0] . AnyEvent::Debug::backtrace };
361 &$cb; 425 &$cb;
362 }; 426 };
363 if ($@) { 427 if ($@) {
364 push @{ $w->{error} }, [AE::now, $@] 428 push @{ $w->{error} }, [AE::now, $@]
365 if @{ $w->{error} } < 10; 429 if @{ $w->{error} } < 10;
… …
381 called => 0, 445 called => 0,
382 }, "AnyEvent::Debug::Wrapped"; 446 }, "AnyEvent::Debug::Wrapped";
383 447
384 delete $arg{cb}; 448 delete $arg{cb};
385 449
386 # backtraces leak like hell 450 $self->{bt} = AnyEvent::Debug::backtrace
387 $self->{bt} = Carp::longmess ""
388 if $WRAP_LEVEL >= 2; 451 if $WRAP_LEVEL >= 2;
389 452
390 Scalar::Util::weaken ($w = $self); 453 Scalar::Util::weaken ($w = $self);
391 Scalar::Util::weaken ($AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $self} = $self); 454 Scalar::Util::weaken ($AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $self} = $self);
392 455
… …
399 462
400package AnyEvent::Debug::Wrapped; 463package AnyEvent::Debug::Wrapped;
401 464
402use AnyEvent (); BEGIN { AnyEvent::common_sense } 465use AnyEvent (); BEGIN { AnyEvent::common_sense }
403 466
404sub _init { 467use overload
405 require overload;
406 import overload
407 '""' => sub { 468 '""' => sub {
408 $_[0]{str} ||= do { 469 $_[0]{str} ||= do {
409 my ($pkg, $line) = @{ $_[0]{caller} }; 470 my ($pkg, $line) = @{ $_[0]{caller} };
410 471
411 my $mod = AnyEvent::Debug::path2mod $_[0]{file}; 472 my $mod = AnyEvent::Debug::path2mod $_[0]{file};
412 my $sub = $_[0]{sub}; 473 my $sub = $_[0]{sub};
413 474
414 if (defined $sub) { 475 if (defined $sub) {
415 $sub =~ s/^\Q$mod\E:://; 476 $sub =~ s/^\Q$mod\E:://;
416 $sub = "($sub)"; 477 $sub = "($sub)";
417 } 478 }
418 479
419 "$mod:$_[0]{line}$sub>$_[0]{type}>" 480 "$mod:$_[0]{line}$sub>$_[0]{type}>"
420 . (AnyEvent::Debug::cb2str $_[0]{cb}) 481 . (AnyEvent::Debug::cb2str $_[0]{cb})
421 };
422 }, 482 };
483 },
423 fallback => 1; 484 fallback => 1,
424} 485;
425 486
426sub verbose { 487sub verbose {
427 my ($self) = @_; 488 my ($self) = @_;
428 489
429 my $res = "type: $self->{type} watcher\n" 490 my $res = "type: $self->{type} watcher\n"
… …
454 print AnyEvent::Debug::ft AE::now, " dstry $_[0]\n" if $TRACE_LEVEL; 515 print AnyEvent::Debug::ft AE::now, " dstry $_[0]\n" if $TRACE_LEVEL;
455 516
456 delete $AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $_[0]}; 517 delete $AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $_[0]};
457} 518}
458 519
520package AnyEvent::Debug::Backtrace;
521
522use AnyEvent (); BEGIN { AnyEvent::common_sense }
523
524sub as_string {
525 my ($self) = @_;
526
527 my @bt;
528 my $modlen;
529
530 for (@$self) {
531 my ($rpath, $line, $sub) = @$_;
532
533 $rpath = (AnyEvent::Debug::path2mod $$rpath) . " line $line";
534 $modlen = length $rpath if $modlen < length $rpath;
535
536 push @bt, [$rpath, $sub];
537 }
538
539 join "",
540 map { sprintf "%*s %s\n", -$modlen, $_->[0], $_->[1] }
541 @bt
542}
543
544use overload
545 '""' => \&as_string,
546 fallback => 1,
547;
548
4591; 5491;
460 550
461=back 551=back
462 552
463=head1 AUTHOR 553=head1 AUTHOR

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines