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.13 by root, Sun Aug 14 03:12:10 2011 UTC vs.
Revision 1.25 by root, Sun Aug 21 03:12:50 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 ();
31 31
32use AnyEvent (); BEGIN { AnyEvent::common_sense } 32use AnyEvent (); BEGIN { AnyEvent::common_sense }
33use AnyEvent::Util (); 33use AnyEvent::Util ();
34use AnyEvent::Socket (); 34use AnyEvent::Socket ();
35use AnyEvent::Log ();
36
37our ($TRACE_LOGGER, $TRACE_ENABLED);
38
39# cache often-used strings, purely to save memory, at the expense of speed
40our %STRCACHE;
35 41
36=item $shell = AnyEvent;::Debug::shell $host, $service 42=item $shell = AnyEvent;::Debug::shell $host, $service
37 43
38This function binds on the given host and service port and returns a 44This function binds on the given host and service port and returns a
39shell object, which determines the lifetime of the shell. Any number 45shell object, which determines the lifetime of the shell. Any number
… …
135 141
136 sub help() { 142 sub help() {
137 <<EOF 143 <<EOF
138help this command 144help this command
139wr [level] sets wrap level to level (or toggles if missing) 145wr [level] sets wrap level to level (or toggles if missing)
140t [level] sets trace level (or toggles if missing) 146v [level] sets verbosity (or toggles if missing)
141wl 'regex' print wrapped watchers matching the regex (or all if missing) 147wl 'regex' print wrapped watchers matching the regex (or all if missing)
142w id,... prints the watcher with the given ids in more detail 148w id,... prints the watcher with the given ids in more detail
143EOF 149EOF
144 } 150 }
145 151
… …
175 AnyEvent::Debug::wrap (@_); 181 AnyEvent::Debug::wrap (@_);
176 182
177 "wrap level now $AnyEvent::Debug::WRAP_LEVEL" 183 "wrap level now $AnyEvent::Debug::WRAP_LEVEL"
178 } 184 }
179 185
180 sub t { 186 sub v {
181 $AnyEvent::Debug::TRACE_LEVEL = @_ ? shift : $AnyEvent::Debug::TRACE_LEVEL ? 0 : 9; 187 #TODO
188 $AnyEvent::VERBOSE = @_ ? shift : $AnyEvent::VERBOSE ? 0 : 9;
182 189
183 "trace level now $AnyEvent::Debug::TRACE_LEVEL" 190 "verbosity level now $AnyEvent::VEBROSE"
184 } 191 }
185} 192}
186 193
187=item AnyEvent::Debug::wrap [$level] 194=item AnyEvent::Debug::wrap [$level]
188 195
… …
195 202
196A level of C<0> disables wrapping, i.e. AnyEvent works normally, and in 203A level of C<0> disables wrapping, i.e. AnyEvent works normally, and in
197its most efficient mode. 204its most efficient mode.
198 205
199A level of C<1> enables wrapping, which replaces all watchers by 206A level of C<1> enables wrapping, which replaces all watchers by
200AnyEvent::Debug::Wrapped objects, stores the location where a watcher was 207AnyEvent::Debug::Wrapped objects, stores the location where a watcher
201created and wraps the callback so invocations of it can be traced. 208was created and wraps the callback to log all invocations at "trace"
209loglevel. The wrapper will also count how many times the callback was
210invoked and will record up to ten runtime errors with corresponding
211backtraces. It will also log runtime errors at "error" loglevel.
212
213To see the trace messages, you can invoke your program with
214C<PERL_ANYEVENT_VERBOSE=9>, or you can use AnyEvent::Log to divert
215the trace messages in any way you like (the EXAMPLES section in
216L<AnyEvent::Log> has some examples).
202 217
203A level of C<2> does everything that level C<1> does, but also stores a 218A level of C<2> does everything that level C<1> does, but also stores a
204full backtrace of the location the watcher was created. 219full backtrace of the location the watcher was created, which slows down
220watcher creation considerably.
205 221
206Every wrapped watcher will be linked into C<%AnyEvent::Debug::Wrapped>, 222Every wrapped watcher will be linked into C<%AnyEvent::Debug::Wrapped>,
207with its address as key. The C<wl> command in the debug shell cna be used 223with its address as key. The C<wl> command in the debug shell cna be used
208to list watchers. 224to list watchers.
209 225
… …
213 229
214Also, enabling and disabling instrumentation will not recover the full 230Also, enabling and disabling instrumentation will not recover the full
215performance that you had before wrapping (the AE::xxx functions will stay 231performance that you had before wrapping (the AE::xxx functions will stay
216slower, for example). 232slower, for example).
217 233
218Currently, enabling wrapping will also load AnyEvent::Strict, but this is 234If you are developing your program, also consider using AnyEvent::Strict
219not be relied upon. 235to check for common mistakes.
220 236
221=cut 237=cut
222 238
223our $WRAP_LEVEL; 239our $WRAP_LEVEL;
224our $TRACE_LEVEL;
225our $TRACE_CUR; 240our $TRACE_CUR;
226our $POST_DETECT; 241our $POST_DETECT;
227 242
228sub wrap(;$) { 243sub wrap(;$) {
229 my $PREV_LEVEL = $WRAP_LEVEL; 244 my $PREV_LEVEL = $WRAP_LEVEL;
230 $WRAP_LEVEL = @_ ? 0+shift : $WRAP_LEVEL ? 0 : 1; 245 $WRAP_LEVEL = @_ ? 0+shift : $WRAP_LEVEL ? 0 : 1;
231 246
232 if (defined $AnyEvent::MODEL) { 247 if ($AnyEvent::MODEL) {
233 unless (defined $PREV_LEVEL) {
234 AnyEvent::Debug::Wrapped::_init ();
235 }
236
237 if ($WRAP_LEVEL && !$PREV_LEVEL) { 248 if ($WRAP_LEVEL && !$PREV_LEVEL) {
249 $TRACE_LOGGER = AnyEvent::Log::logger trace => \$TRACE_ENABLED;
238 AnyEvent::_isa_hook 1 => "AnyEvent::Debug::Wrap", 1; 250 AnyEvent::_isa_hook 0 => "AnyEvent::Debug::Wrap", 1;
239 AnyEvent::Debug::Wrap::_reset (); 251 AnyEvent::Debug::Wrap::_reset ();
240 } elsif (!$WRAP_LEVEL && $PREV_LEVEL) { 252 } elsif (!$WRAP_LEVEL && $PREV_LEVEL) {
241 AnyEvent::_isa_hook 0 => undef; 253 AnyEvent::_isa_hook 0 => undef;
242 } 254 }
243 } else { 255 } else {
… …
289 301
290Using various gambits, tries to convert a callback (e.g. a code reference) 302Using various gambits, tries to convert a callback (e.g. a code reference)
291into a more useful string. 303into a more useful string.
292 304
293Very useful if you debug a program and have some callback, but you want to 305Very useful if you debug a program and have some callback, but you want to
294know where in the program the callbakc is actually defined. 306know where in the program the callback is actually defined.
295 307
296=cut 308=cut
297 309
298sub cb2str($) { 310sub cb2str($) {
299 my $cb = shift; 311 my $cb = shift;
… …
312 if $gv->NAME eq "__ANON__"; 324 if $gv->NAME eq "__ANON__";
313 325
314 return $gv->STASH->NAME . "::" . $gv->NAME; 326 return $gv->STASH->NAME . "::" . $gv->NAME;
315} 327}
316 328
317# Format Time, not public - yet?
318sub ft($) { 329sub sv2str($) {
330 if (ref $_[0]) {
331 if (ref $_[0] eq "CODE") {
332 return "$_[0]=" . cb2str $_[0];
333 } else {
334 return "$_[0]";
335 }
336 } else {
337 for ("\'$_[0]\'") { # make copy
338 substr $_, $Carp::MaxArgLen, length, "'..."
339 if length > $Carp::MaxArgLen;
340 return $_;
341 }
342 }
343}
344
345=item AnyEvent::Debug::backtrace [$skip]
346
347Creates a backtrace (actually an AnyEvent::Debug::Backtrace object
348that you can stringify), not unlike the Carp module would. Unlike the
349Carp module it resolves some references (euch as callbacks) to more
350user-friendly strings, has a more succinct output format and most
351importantly: doesn't leak memory like hell.
352
353The reason it creates an object is to save time, as formatting can be
354done at a later time. Still, creating a backtrace is a relatively slow
355operation.
356
357=cut
358
359sub backtrace(;$) {
319 my $t = shift; 360 my $w = shift;
320 my $i = int $t;
321 my $f = sprintf "%06d", 1e6 * ($t - $i);
322 361
323 POSIX::strftime "%Y-%m-%d %H:%M:%S.$f %z", localtime $i 362 my (@bt, @c);
363 my ($modlen, $sub);
364
365 for (;;) {
366 # 0 1 2 3 4 5 6 7 8 9 10
367 # ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash)
368 package DB;
369 @c = caller $w++
370 or last;
371 package AnyEvent::Debug; # no block for speed reasons
372
373 if ($c[7]) {
374 $sub = "require $c[6]";
375 } elsif (defined $c[6]) {
376 $sub = "eval \"\"";
377 } else {
378 $sub = ($c[4] ? "" : "&") . $c[3];
379
380 $sub .= "("
381 . (join ",",
382 map sv2str $DB::args[$_],
383 0 .. (@DB::args < $Carp::MaxArgNums ? @DB::args : $Carp::MaxArgNums) - 1)
384 . ")"
385 if $c[4];
386 }
387
388 push @bt, [\($STRCACHE{$c[1]} ||= $c[1]), $c[2], $sub];
389 }
390
391 @DB::args = ();
392
393 bless \@bt, "AnyEvent::Debug::Backtrace"
324} 394}
395
396=back
397
398=cut
325 399
326package AnyEvent::Debug::Wrap; 400package AnyEvent::Debug::Wrap;
327 401
328use AnyEvent (); BEGIN { AnyEvent::common_sense } 402use AnyEvent (); BEGIN { AnyEvent::common_sense }
329use Scalar::Util (); 403use Scalar::Util ();
… …
341 my ($pkg, $file, $line, $sub); 415 my ($pkg, $file, $line, $sub);
342 416
343 $w = 0; 417 $w = 0;
344 do { 418 do {
345 ($pkg, $file, $line) = caller $w++; 419 ($pkg, $file, $line) = caller $w++;
346 } while $pkg =~ /^(?:AE|AnyEvent::(?:Socket|Util|Debug|Strict|Base|CondVar|CondVar::Base|Impl::.*))$/; 420 } while $pkg =~ /^(?:AE|AnyEvent::(?:Socket|Handle|Util|Debug|Strict|Base|CondVar|CondVar::Base|Impl::.*)|Coro::AnyEvent::CondVar)$/;
347 421
348 $sub = (caller $w++)[3]; 422 $sub = (caller $w)[3];
349 423
350 my $cb = $arg{cb}; 424 my $cb = $arg{cb};
351 $arg{cb} = sub { 425 $arg{cb} = sub {
352 ++$w->{called}; 426 ++$w->{called};
353 427
354 return &$cb
355 unless $TRACE_LEVEL;
356
357 local $TRACE_CUR = "$w"; 428 local $TRACE_CUR = $w;
358 print AnyEvent::Debug::ft AE::now, " enter $TRACE_CUR\n" if $TRACE_LEVEL; 429
430 $TRACE_LOGGER->("enter $w") if $TRACE_ENABLED;
359 eval { 431 eval {
360 local $SIG{__DIE__} = sub { die Carp::longmess "$_[0]Backtrace starting" }; 432 local $SIG{__DIE__} = sub {
433 die $_[0] . AnyEvent::Debug::backtrace
434 if defined $^S;
435 };
361 &$cb; 436 &$cb;
362 }; 437 };
363 if ($@) { 438 if ($@) {
364 push @{ $w->{error} }, [AE::now, $@] 439 push @{ $w->{error} }, [AE::now, "$@"]
365 if @{ $w->{error} } < 10; 440 if @{ $w->{error} } < 10;
366 print AnyEvent::Debug::ft AE::now, " ERROR $TRACE_CUR $@"; 441 AE::log die => "($w) $@"
442 or warn "($w) $@";
367 } 443 }
368 print AnyEvent::Debug::ft AE::now, " leave $TRACE_CUR\n" if $TRACE_LEVEL; 444 $TRACE_LOGGER->("leave $w") if $TRACE_ENABLED;
369 }; 445 };
370 446
371 $self = bless { 447 $self = bless {
372 type => $name, 448 type => $name,
373 w => $self->$super (%arg), 449 w => $self->$super (%arg),
374 file => $file, 450 rfile => \($STRCACHE{$file} ||= $file),
375 line => $line, 451 line => $line,
376 sub => $sub, 452 sub => $sub,
377 cur => $TRACE_CUR, 453 cur => "$TRACE_CUR",
378 now => AE::now, 454 now => AE::now,
379 arg => \%arg, 455 arg => \%arg,
380 cb => $cb, 456 cb => $cb,
381 called => 0, 457 called => 0,
382 }, "AnyEvent::Debug::Wrapped"; 458 }, "AnyEvent::Debug::Wrapped";
383 459
384 delete $arg{cb}; 460 delete $arg{cb};
385 461
386 # backtraces leak like hell 462 $self->{bt} = AnyEvent::Debug::backtrace 1
387 $self->{bt} = Carp::longmess ""
388 if $WRAP_LEVEL >= 2; 463 if $WRAP_LEVEL >= 2;
389 464
390 Scalar::Util::weaken ($w = $self); 465 Scalar::Util::weaken ($w = $self);
391 Scalar::Util::weaken ($AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $self} = $self); 466 Scalar::Util::weaken ($AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $self} = $self);
392 467
393 print AnyEvent::Debug::ft AE::now, " creat $w\n" if $TRACE_LEVEL; 468 $TRACE_LOGGER->("creat $w") if $TRACE_ENABLED;
394 469
395 $self 470 $self
396 }; 471 };
397 } 472 }
398} 473}
399 474
400package AnyEvent::Debug::Wrapped; 475package AnyEvent::Debug::Wrapped;
401 476
477=head1 THE AnyEvent::Debug::Wrapped CLASS
478
479All watchers created while the wrap level is non-zero will be wrapped
480inside an AnyEvent::Debug::Wrapped object. The address of the
481wrapped watcher will become its ID - every watcher will be stored in
482C<$AnyEvent::Debug::Wrapped{$id}>.
483
484These wrapper objects, as of now, can be stringified, and you can call the
485C<< ->verbose >> method to get a multiline string describing the watcher
486in great detail, but otherwise has no other public methods.
487
488For debugging, of course, it can be helpful to look into these objects,
489which is why this is documented here, but this might change at any time in
490future versions.
491
492Each object is a relatively standard hash with the following members:
493
494 type => name of the method used ot create the watcher (e.g. C<io>, C<timer>).
495 w => the actual watcher
496 rfile => reference to the filename of the file the watcher was created in
497 line => line number where it was created
498 sub => function name (or a special string) which created the watcher
499 cur => if created inside another watcher callback, this is the string rep of the other watcher
500 now => the timestamp (AE::now) when the watcher was created
501 arg => the arguments used to create the watcher (sans C<cb>)
502 cb => the original callback used to create the watcher
503 called => the number of times the callback was called
504
505=cut
506
402use AnyEvent (); BEGIN { AnyEvent::common_sense } 507use AnyEvent (); BEGIN { AnyEvent::common_sense }
403 508
404sub _init { 509use overload
405 require overload;
406 import overload
407 '""' => sub { 510 '""' => sub {
408 $_[0]{str} ||= do { 511 $_[0]{str} ||= do {
409 my ($pkg, $line) = @{ $_[0]{caller} }; 512 my ($pkg, $line) = @{ $_[0]{caller} };
410 513
411 my $mod = AnyEvent::Debug::path2mod $_[0]{file}; 514 my $mod = AnyEvent::Debug::path2mod ${ $_[0]{rfile} };
412 my $sub = $_[0]{sub}; 515 my $sub = $_[0]{sub};
413 516
414 if (defined $sub) { 517 if (defined $sub) {
415 $sub =~ s/^\Q$mod\E:://; 518 $sub =~ s/^\Q$mod\E:://;
416 $sub = "($sub)"; 519 $sub = "($sub)";
417 } 520 }
418 521
419 "$mod:$_[0]{line}$sub>$_[0]{type}>" 522 "$mod:$_[0]{line}$sub>$_[0]{type}>"
420 . (AnyEvent::Debug::cb2str $_[0]{cb}) 523 . (AnyEvent::Debug::cb2str $_[0]{cb})
421 };
422 }, 524 };
525 },
423 fallback => 1; 526 fallback => 1,
424} 527;
425 528
426sub verbose { 529sub verbose {
427 my ($self) = @_; 530 my ($self) = @_;
428 531
429 my $res = "type: $self->{type} watcher\n" 532 my $res = "type: $self->{type} watcher\n"
430 . "args: " . (join " ", %{ $self->{arg} }) . "\n" # TODO: decode fh? 533 . "args: " . (join " ", %{ $self->{arg} }) . "\n" # TODO: decode fh?
431 . "created: " . (AnyEvent::Debug::ft $self->{now}) . " ($self->{now})\n" 534 . "created: " . (AnyEvent::Log::ft $self->{now}) . " ($self->{now})\n"
432 . "file: $self->{file}\n" 535 . "file: ${ $self->{rfile} }\n"
433 . "line: $self->{line}\n" 536 . "line: $self->{line}\n"
434 . "subname: $self->{sub}\n" 537 . "subname: $self->{sub}\n"
435 . "context: $self->{cur}\n" 538 . "context: $self->{cur}\n"
436 . "cb: $self->{cb} (" . (AnyEvent::Debug::cb2str $self->{cb}) . ")\n" 539 . "cb: $self->{cb} (" . (AnyEvent::Debug::cb2str $self->{cb}) . ")\n"
437 . "invoked: $self->{called} times\n"; 540 . "invoked: $self->{called} times\n";
438 541
439 if (exists $self->{bt}) { 542 if (exists $self->{bt}) {
440 $res .= "created$self->{bt}"; 543 $res .= "created\n$self->{bt}";
441 } 544 }
442 545
443 if (exists $self->{error}) { 546 if (exists $self->{error}) {
444 $res .= "errors: " . @{$self->{error}} . "\n"; 547 $res .= "errors: " . @{$self->{error}} . "\n";
445 548
446 $res .= "error: " . (AnyEvent::Debug::ft $_->[0]) . " ($_->[0]) $_->[1]\n" 549 $res .= "error: " . (AnyEvent::Log::ft $_->[0]) . " ($_->[0]) $_->[1]\n"
447 for @{$self->{error}}; 550 for @{$self->{error}};
448 } 551 }
449 552
450 $res 553 $res
451} 554}
452 555
453sub DESTROY { 556sub DESTROY {
454 print AnyEvent::Debug::ft AE::now, " dstry $_[0]\n" if $TRACE_LEVEL; 557 $TRACE_LOGGER->("dstry $_[0]") if $TRACE_ENABLED;
455 558
456 delete $AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $_[0]}; 559 delete $AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $_[0]};
457} 560}
458 561
562package AnyEvent::Debug::Backtrace;
563
564use AnyEvent (); BEGIN { AnyEvent::common_sense }
565
566sub as_string {
567 my ($self) = @_;
568
569 my @bt;
570 my $modlen;
571
572 for (@$self) {
573 my ($rpath, $line, $sub) = @$_;
574
575 $rpath = (AnyEvent::Debug::path2mod $$rpath) . " line $line";
576 $modlen = length $rpath if $modlen < length $rpath;
577
578 push @bt, [$rpath, $sub];
579 }
580
581 join "",
582 map { sprintf "%*s %s\n", -$modlen, $_->[0], $_->[1] }
583 @bt
584}
585
586use overload
587 '""' => \&as_string,
588 fallback => 1,
589;
590
4591; 5911;
460
461=back
462 592
463=head1 AUTHOR 593=head1 AUTHOR
464 594
465 Marc Lehmann <schmorp@schmorp.de> 595 Marc Lehmann <schmorp@schmorp.de>
466 http://home.schmorp.de/ 596 http://home.schmorp.de/

Diff Legend

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