view release on metacpan or  search on metacpan

lib/AnyEvent/Debug.pm  view on Meta::CPAN

Creates a backtrace (actually an AnyEvent::Debug::Backtrace object
that you can stringify), not unlike the Carp module would. Unlike the
Carp module it resolves some references (such as callbacks) to more
user-friendly strings, has a more succinct output format and most
importantly: doesn't leak memory like hell.

The reason it creates an object is to save time, as formatting can be
done at a later time. Still, creating a backtrace is a relatively slow
operation.

=cut

sub backtrace(;$) {
   my $w = shift;

   my (@bt, @c);
   my ($modlen, $sub);

   for (;;) {
      #         0          1      2            3         4           5          6            7       8         9         10
      # ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash)
      package DB;
      @c = caller $w++
         or last;
      package AnyEvent::Debug; # no block for speed reasons

      if ($c[7]) {
         $sub = "require $c[6]";
      } elsif (defined $c[6]) {
         $sub = "eval \"\"";
      } else {
         $sub = ($c[4] ? "" : "&") . $c[3];

         $sub .= "("
                 . (join ",",
                       map sv2str $DB::args[$_],
                          0 .. (@DB::args < $Carp::MaxArgNums ? @DB::args : $Carp::MaxArgNums) - 1)
                 . ")"
            if $c[4];
      }

      push @bt, [\($STRCACHE{$c[1]} ||= $c[1]), $c[2], $sub];
   }

   @DB::args = ();

   bless \@bt, "AnyEvent::Debug::Backtrace"
}

=back

=cut

package AnyEvent::Debug::Wrap;

use AnyEvent (); BEGIN { AnyEvent::common_sense }
use Scalar::Util ();
use Carp ();

sub _reset {
   for my $name (qw(io timer signal child idle)) {
      my $super = "SUPER::$name";

      *$name = sub {
         my ($self, %arg) = @_;

         my $w;

         my $t = $TRACE;

         my ($pkg, $file, $line, $sub);
         
         $w = 0;
         do {
            ($pkg, $file, $line) = caller $w++;
         } while $pkg =~ /^(?:AE|AnyEvent::(?:Socket|Handle|Util|Debug|Strict|Base|CondVar|CondVar::Base|Impl::.*)|Coro::AnyEvent::CondVar)$/;

         $sub = (caller $w)[3];

         my $cb = $arg{cb};
         $arg{cb} = sub {
            ++$w->{called};

            local $TRACE_CUR = $w;

            $TRACE_LOGGER->("enter $w") if $TRACE_ENABLED && $t;
            eval {
               local $SIG{__DIE__} = sub {
                  die $_[0] . AnyEvent::Debug::backtrace
                     if defined $^S;
               };
               &$cb;
            };
            if ($@) {
               my $err = "$@";
               push @{ $w->{error} }, [AE::now, $err]
                  if @{ $w->{error} } < 10;
               AE::log die => "($w) $err"
                  or warn "($w) $err";
            }
            $TRACE_LOGGER->("leave $w") if $TRACE_ENABLED && $t;
         };

         $self = bless {
            type   => $name,
            w      => $self->$super (%arg),
            rfile  => \($STRCACHE{$file} ||= $file),
            line   => $line,
            sub    => $sub,
            cur    => "$TRACE_CUR",
            now    => AE::now,
            arg    => \%arg,
            cb     => $cb,
            called => 0,
            rt     => \$t,
         }, "AnyEvent::Debug::Wrapped";

         delete $arg{cb};

         $self->{bt} = AnyEvent::Debug::backtrace 1
            if $WRAP_LEVEL >= 2;

         Scalar::Util::weaken ($w = $self);
         Scalar::Util::weaken ($AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $self} = $self);

         $TRACE_LOGGER->("creat $w") if $TRACE_ENABLED && $t;

         $self
      };
   }
}

package AnyEvent::Debug::Wrapped;

=head1 THE AnyEvent::Debug::Wrapped CLASS

All watchers created while the wrap level is non-zero will be wrapped
inside an AnyEvent::Debug::Wrapped object. The address of the
wrapped watcher will become its ID - every watcher will be stored in
C<$AnyEvent::Debug::Wrapped{$id}>.

These wrapper objects can be stringified and have some methods defined on
them.

For debugging, of course, it can be helpful to look into these objects,
which is why this is documented here, but this might change at any time in
future versions.

Each object is a relatively standard hash with the following members:

   type   => name of the method used ot create the watcher (e.g. C<io>, C<timer>).
   w      => the actual watcher
   rfile  => reference to the filename of the file the watcher was created in
   line   => line number where it was created
   sub    => function name (or a special string) which created the watcher
   cur    => if created inside another watcher callback, this is the string rep of the other watcher
   now    => the timestamp (AE::now) when the watcher was created
   arg    => the arguments used to create the watcher (sans C<cb>)
   cb     => the original callback used to create the watcher
   called => the number of times the callback was called

Each object supports the following mehtods (warning: these are only
available on wrapped watchers, so are best for interactive use via the
debug shell).

=over 4

=cut

use AnyEvent (); BEGIN { AnyEvent::common_sense }

use overload
   '""'     => sub {
      $_[0]{str} ||= do {
         my ($pkg, $line) = @{ $_[0]{caller} };

         my $mod = AnyEvent::Debug::path2mod ${ $_[0]{rfile} };
         my $sub = $_[0]{sub};

         if (defined $sub) {
            $sub =~ s/^\Q$mod\E:://;
            $sub = "($sub)";
         }

         "$mod:$_[0]{line}$sub>$_[0]{type}>"
         . (AnyEvent::Debug::cb2str $_[0]{cb})
      };
   },
   fallback => 1,
;

=item $w->id

Returns the numerical id of the watcher, as used in the debug shell.

=cut

sub id {
   Scalar::Util::refaddr shift
}

=item $w->verbose

Returns a multiline textual description of the watcher, including the
first ten exceptions caught while executing the callback.

=cut

sub verbose {
   my ($self) = @_;