AnyEvent

 view release on metacpan or  search on metacpan

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

=head1 NAME

AnyEvent::Debug - debugging utilities for AnyEvent

=head1 SYNOPSIS

   use AnyEvent::Debug;

   # create an interactive shell into the program
   my $shell = AnyEvent::Debug::shell "unix/", "/home/schmorp/myshell";
   # then on the shell: "socat readline /home/schmorp/myshell"

=head1 DESCRIPTION

This module provides functionality hopefully useful for debugging.

At the moment, "only" an interactive shell is implemented. This shell
allows you to interactively "telnet into" your program and execute Perl
code, e.g. to look at global variables.

=head1 FUNCTIONS

=over 4

=cut

package AnyEvent::Debug;

use B ();
use Carp ();
use Errno ();

use AnyEvent (); BEGIN { AnyEvent::common_sense }
use AnyEvent::Util ();
use AnyEvent::Socket ();
use AnyEvent::Log ();

our $TRACE = 1; # trace status

our ($TRACE_LOGGER, $TRACE_ENABLED);

# cache often-used strings, purely to save memory, at the expense of speed
our %STRCACHE;

=item $shell = AnyEvent::Debug::shell $host, $service

This function binds on the given host and service port and returns a
shell object, which determines the lifetime of the shell. Any number
of connections are accepted on the port, and they will give you a very
primitive shell that simply executes every line you enter.

All commands will be executed "blockingly" with the socket C<select>ed for
output. For a less "blocking" interface see L<Coro::Debug>.

The commands will be executed in the C<AnyEvent::Debug::shell> package,
which currently has "help" and a few other commands, and can be freely
modified by all shells. Code is evaluated under C<use strict 'subs'>.

Every shell has a logging context (C<$LOGGER>) that is attached to
C<$AnyEvent::Log::COLLECT>), which is especially useful to gether debug
and trace messages.

As a general programming guide, consider the beneficial aspects of
using more global (C<our>) variables than local ones (C<my>) in package
scope: Earlier all my modules tended to hide internal variables inside
C<my> variables, so users couldn't accidentally access them. Having
interactive access to your programs changed that: having internal
variables still in the global scope means you can debug them easier.

As no authentication is done, in most cases it is best not to use a TCP
port, but a unix domain socket, whcih can be put wherever you can access
it, but not others:

   our $SHELL = AnyEvent::Debug::shell "unix/", "/home/schmorp/shell";

Then you can use a tool to connect to the shell, such as the ever
versatile C<socat>, which in addition can give you readline support:

   socat readline /home/schmorp/shell
   # or:
   cd /home/schmorp; socat readline unix:shell

Socat can even give you a persistent history:

   socat readline,history=.anyevent-history unix:shell

Binding on C<127.0.0.1> (or C<::1>) might be a less secure but sitll not
totally insecure (on single-user machines) alternative to let you use
other tools, such as telnet:

   our $SHELL = AnyEvent::Debug::shell "127.1", "1357";

And then:

   telnet localhost 1357

=cut

sub shell($$) {
   local $TRACE = 0;

   AnyEvent::Socket::tcp_server $_[0], $_[1], sub {
      my ($fh, $host, $port) = @_;

      syswrite $fh, "Welcome, $host:$port, use 'help' for more info!\015\012> ";
      my $rbuf;

      my $logger = new AnyEvent::Log::Ctx
         log_cb => sub {
            syswrite $fh, shift;
            0
         };

      my $logger_guard = AnyEvent::Util::guard {
         $AnyEvent::Log::COLLECT->detach ($logger);
      };
      $AnyEvent::Log::COLLECT->attach ($logger);

      local $TRACE = 0;
      my $rw; $rw = AE::io $fh, 0, sub {
         my $len = sysread $fh, $rbuf, 1024, length $rbuf;

         $logger_guard if 0; # reference it

         if (defined $len ? $len == 0 : ($! != Errno::EAGAIN && $! != Errno::EWOULDBLOCK)) {
            undef $rw;
         } else {
            while ($rbuf =~ s/^(.*)\015?\012//) {

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

   sub i {
      join "",
         map $_->id . " $_\n" . $_->verbose . "\n",
            &w
   }

   sub wr {
      AnyEvent::Debug::wrap (@_);

      "wrap level now $AnyEvent::Debug::WRAP_LEVEL"
   }

   sub t {
      if (@_) {
         @_ = &w;
         $_->trace (1)
            for @_;
         "tracing enabled for @_."
      } else {
         $AnyEvent::Debug::TRACE = 1;
         "tracing for newly created watchers is now enabled."
      }
   }

   sub u {
      if (@_) {
         @_ = &w;
         $_->trace (0)
            for @_;
         "tracing disabled for @_."
      } else {
         $AnyEvent::Debug::TRACE = 0;
         "tracing for newly created watchers is now disabled."
      }
   }

   sub v {
      $LOGGER->level (@_ ? $_[0] : $LOGGER->[1] ? 0 : 9);

      "verbose logging is now " . ($LOGGER->[1] ? "enabled" : "disabled") . "."
   }
}

=item AnyEvent::Debug::wrap [$level]

Sets the instrumenting/wrapping level of all watchers that are being
created after this call. If no C<$level> has been specified, then it
toggles between C<0> and C<1>.

The default wrap level is C<0>, or whatever
C<$ENV{PERL_ANYEVENT_DEBUG_WRAP}> specifies.

A level of C<0> disables wrapping, i.e. AnyEvent works normally, and in
its most efficient mode.

A level of C<1> or higher enables wrapping, which replaces all watchers
by AnyEvent::Debug::Wrapped objects, stores the location where a
watcher was created and wraps the callback to log all invocations at
"trace" loglevel if tracing is enabled fore the watcher. The initial
state of tracing when creating a watcher is taken from the global
variable C<$AnyEvent:Debug::TRACE>. The default value of that variable
is C<1>, but it can make sense to set it to C<0> and then do C<< local
$AnyEvent::Debug::TRACE = 1 >> in a block where you create "interesting"
watchers. Tracing can also be enabled and disabled later by calling the
watcher's C<trace> method.

The wrapper will also count how many times the callback was invoked and
will record up to ten runtime errors with corresponding backtraces. It
will also log runtime errors at "error" loglevel.

To see the trace messages, you can invoke your program with
C<PERL_ANYEVENT_VERBOSE=9>, or you can use AnyEvent::Log to divert
the trace messages in any way you like (the EXAMPLES section in
L<AnyEvent::Log> has some examples).

A level of C<2> does everything that level C<1> does, but also stores a
full backtrace of the location the watcher was created, which slows down
watcher creation considerably.

Every wrapped watcher will be linked into C<%AnyEvent::Debug::Wrapped>,
with its address as key. The C<wl> command in the debug shell can be used
to list watchers.

Instrumenting can increase the size of each watcher multiple times, and,
especially when backtraces are involved, also slows down watcher creation
a lot.

Also, enabling and disabling instrumentation will not recover the full
performance that you had before wrapping (the AE::xxx functions will stay
slower, for example).

If you are developing your program, also consider using AnyEvent::Strict
to check for common mistakes.

=cut

our $WRAP_LEVEL;
our $TRACE_CUR;
our $POST_DETECT;

sub wrap(;$) {
   my $PREV_LEVEL = $WRAP_LEVEL;
   $WRAP_LEVEL = @_ ? 0+shift : $WRAP_LEVEL ? 0 : 1;

   if ($AnyEvent::MODEL) {
      if ($WRAP_LEVEL && !$PREV_LEVEL) {
         $TRACE_LOGGER = AnyEvent::Log::logger trace => \$TRACE_ENABLED;
         AnyEvent::_isa_hook 0 => "AnyEvent::Debug::Wrap", 1;
         AnyEvent::Debug::Wrap::_reset ();
      } elsif (!$WRAP_LEVEL && $PREV_LEVEL) {
         AnyEvent::_isa_hook 0 => undef;
      }
   } else {
      $POST_DETECT ||= AnyEvent::post_detect {
         undef $POST_DETECT;
         return unless $WRAP_LEVEL;

         (my $level, $WRAP_LEVEL) = ($WRAP_LEVEL, undef);

         require AnyEvent::Strict unless $AnyEvent::Strict::VERSION;

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

            $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) = @_;

   my $res = "type:    $self->{type} watcher\n"
           . "args:    " . (join " ", %{ $self->{arg} }) . "\n" # TODO: decode fh?
           . "created: " . (AnyEvent::Log::format_time $self->{now}) . " ($self->{now})\n"
           . "file:    ${ $self->{rfile} }\n"
           . "line:    $self->{line}\n"
           . "subname: $self->{sub}\n"
           . "context: $self->{cur}\n"
           . "tracing: " . (${ $self->{rt} } ? "enabled" : "disabled") . "\n"
           . "cb:      $self->{cb} (" . (AnyEvent::Debug::cb2str $self->{cb}) . ")\n"
           . "invoked: $self->{called} times\n";

   if (exists $self->{bt}) {
      $res .= "created\n$self->{bt}";
   }

   if (exists $self->{error}) {
      $res .= "errors:   " . @{$self->{error}} . "\n";

      $res .= "error: " . (AnyEvent::Log::format_time $_->[0]) . " ($_->[0]) $_->[1]\n"
         for @{$self->{error}};
   }

   $res
}

=item $w->trace ($on)

Enables (C<$on> is true) or disables (C<$on> is false) tracing on this
watcher.

To get tracing messages, both the global logging settings must have trace
messages enabled for the context C<AnyEvent::Debug> and tracing must be
enabled for the wrapped watcher.

To enable trace messages globally, the simplest way is to start the
program with C<PERL_ANYEVENT_VERBOSE=9> in the environment.

Tracing for each individual watcher is enabled by default (unless
C<$AnyEvent::Debug::TRACE> has been set to false).

=cut

sub trace {
   ${ $_[0]{rt} } = $_[1];
}

sub DESTROY {
   $TRACE_LOGGER->("dstry $_[0]") if $TRACE_ENABLED && ${ $_[0]{rt} };

   delete $AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $_[0]};
}

=back

=cut

package AnyEvent::Debug::Backtrace;

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

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

   my @bt;
   my $modlen;

   for (@$self) {
      my ($rpath, $line, $sub) = @$_;

      $rpath = (AnyEvent::Debug::path2mod $$rpath) . " line $line";
      $modlen = length $rpath if $modlen < length $rpath;

      $sub =~ s/\r/\\r/g;
      $sub =~ s/\n/\\n/g;
      $sub =~ s/([\x00-\x1f\x7e-\xff])/sprintf "\\x%02x", ord $1/ge;
      $sub =~ s/([^\x20-\x7e])/sprintf "\\x{%x}", ord $1/ge;

      push @bt, [$rpath, $sub];
   }

   join "",
      map { sprintf "%*s %s\n", -$modlen, $_->[0], $_->[1] }
         @bt
}

use overload
   '""'     => \&as_string,
   fallback => 1,
;

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://anyevent.schmorp.de