lib/AnyEvent/Debug.pm

=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 conenctions 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) {
            undef $rw;
         } else {
            while ($rbuf =~ s/^(.*)\015?\012//) {
               my $line = $1;

               AnyEvent::Util::fh_nonblocking $fh, 0;

               if ($line =~ /^\s*exit\b/) {
                  syswrite $fh, "sorry, no... if you want to execute exit, try CORE::exit.\015\012";
               } else {
                  package AnyEvent::Debug::shell;

                  no strict 'vars';
                  local $LOGGER = $logger;
                  my $old_stdout = select $fh;
                  local $| = 1;

                  my @res = eval $line;

                  select $old_stdout;
                  syswrite $fh, "$@" if $@;
                  syswrite $fh, "\015\012";

                  if (@res > 1) {
                     syswrite $fh, "$_: $res[$_]\015\012" for 0 .. $#res;
                  } elsif (@res == 1) {
                     syswrite $fh, "$res[0]\015\012";
                  }
               }

               syswrite $fh, "> ";
               AnyEvent::Util::fh_nonblocking $fh, 1;
            }
         }
      };
   }
}

{
   package AnyEvent::Debug::shell;

   our $LOGGER;

   sub help() {
      <<EOF
help         this command
wr [level]   sets wrap level to level (or toggles if missing)
v [level]    sets verbosity (or toggles between 0 and 9 if missing)
wl 'regex'   print wrapped watchers matching the regex (or all if missing)
i id,...     prints the watcher with the given ids in more detail
t            enable tracing for newly created watchers (enabled by default)
ut           disable tracing for newly created watchers
t  id,...    enable tracing for the given watcher (enabled by default)
ut id,...    disable tracing for the given watcher
w id,...     converts the watcher ids to watcher objects (for scripting)
EOF
   }

   sub wl(;$) {
      my $re = @_ ? qr<$_[0]>i : qr<.>;

      my %res;

      while (my ($k, $v) = each %AnyEvent::Debug::Wrapped) {
         my $s = "$v";
         $res{$s} = $k . (exists $v->{error} ? "*" : " ")
            if $s =~ $re;
      }

      join "", map "$res{$_} $_\n", sort keys %res
   }

   sub w {
      map {
         $AnyEvent::Debug::Wrapped{$_} || do {
            print "$_: no such wrapped watcher.\n";
            ()
         }
      } @_
   }

   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;

         AnyEvent::post_detect { # make sure we run after AnyEvent::Strict
            wrap ($level);
         };
      };
   }
}

=item AnyEvent::Debug::path2mod $path

Tries to replace a path (e.g. the file name returned by caller)
by a module name. Returns the path unchanged if it fails.

Example:

   print AnyEvent::Debug::path2mod "/usr/lib/perl5/AnyEvent/Debug.pm";
   # might print "AnyEvent::Debug"

=cut

sub path2mod($) {
   keys %INC; # reset iterator

   while (my ($k, $v) = each %INC) {
      if ($_[0] eq $v) {
         $k =~ s%/%::%g if $k =~ s/\.pm$//;
         return $k;
      }
   }

   my $path = shift;

   $path =~ s%^\./%%;

   $path
}

=item AnyEvent::Debug::cb2str $cb

Using various gambits, tries to convert a callback (e.g. a code reference)
into a more useful string.

Very useful if you debug a program and have some callback, but you want to
know where in the program the callback is actually defined.

=cut

sub cb2str($) {
   my $cb = shift;

   "CODE" eq ref $cb
      or return "$cb";

   eval {
      my $cv = B::svref_2object ($cb);

      my $gv = $cv->GV
         or return "$cb";

      my $name = $gv->NAME;

      return (AnyEvent::Debug::path2mod $gv->FILE) . ":" . $gv->LINE
         if $name eq "__ANON__";

      $gv->STASH->NAME . "::" . $name;
   } || "$cb"
}

sub sv2str($) {
   if (ref $_[0]) {
      if (ref $_[0] eq "CODE") {
         return "$_[0]=" . cb2str $_[0];
      } else {
         return "$_[0]";
      }
   } else {
      for ("\'$_[0]\'") { # make copy
         substr $_, $Carp::MaxArgLen, length, "'..."
            if length > $Carp::MaxArgLen;
         return $_;
      }
   }
}

=item AnyEvent::Debug::backtrace [$skip]

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

   my $res = "type:    $self->{type} watcher\n"
           . "args:    " . (join " ", %{ $self->{arg} }) . "\n" # TODO: decode fh?
           . "created: " . (AnyEvent::Log::ft $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::ft $_->[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

=cut

1

Revision:	1.41
Committed:	Tue Sep 25 17:21:07 2012 UTC (11 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-7_04, rel-7_03
Changes since 1.40:	+1 -1 lines
Log Message:	* empty log message *
#	Content
1	=head1 NAME
2
3	AnyEvent::Debug - debugging utilities for AnyEvent
4
5	=head1 SYNOPSIS
6
7	use AnyEvent::Debug;
8
9	# create an interactive shell into the program
10	my $shell = AnyEvent::Debug::shell "unix/", "/home/schmorp/myshell";
11	# then on the shell: "socat readline /home/schmorp/myshell"
12
13	=head1 DESCRIPTION
14
15	This module provides functionality hopefully useful for debugging.
16
17	At the moment, "only" an interactive shell is implemented. This shell
18	allows you to interactively "telnet into" your program and execute Perl
19	code, e.g. to look at global variables.
20
21	=head1 FUNCTIONS
22
23	=over 4
24
25	=cut
26
27	package AnyEvent::Debug;
28
29	use B ();
30	use Carp ();
31	use Errno ();
32
33	use AnyEvent (); BEGIN { AnyEvent::common_sense }
34	use AnyEvent::Util ();
35	use AnyEvent::Socket ();
36	use AnyEvent::Log ();
37
38	our $TRACE = 1; # trace status
39
40	our ($TRACE_LOGGER, $TRACE_ENABLED);
41
42	# cache often-used strings, purely to save memory, at the expense of speed
43	our %STRCACHE;
44
45	=item $shell = AnyEvent::Debug::shell $host, $service
46
47	This function binds on the given host and service port and returns a
48	shell object, which determines the lifetime of the shell. Any number
49	of conenctions are accepted on the port, and they will give you a very
50	primitive shell that simply executes every line you enter.
51
52	All commands will be executed "blockingly" with the socket C<select>ed for
53	output. For a less "blocking" interface see L<Coro::Debug>.
54
55	The commands will be executed in the C<AnyEvent::Debug::shell> package,
56	which currently has "help" and a few other commands, and can be freely
57	modified by all shells. Code is evaluated under C<use strict 'subs'>.
58
59	Every shell has a logging context (C<$LOGGER>) that is attached to
60	C<$AnyEvent::Log::COLLECT>), which is especially useful to gether debug
61	and trace messages.
62
63	As a general programming guide, consider the beneficial aspects of
64	using more global (C<our>) variables than local ones (C<my>) in package
65	scope: Earlier all my modules tended to hide internal variables inside
66	C<my> variables, so users couldn't accidentally access them. Having
67	interactive access to your programs changed that: having internal
68	variables still in the global scope means you can debug them easier.
69
70	As no authentication is done, in most cases it is best not to use a TCP
71	port, but a unix domain socket, whcih can be put wherever you can access
72	it, but not others:
73
74	our $SHELL = AnyEvent::Debug::shell "unix/", "/home/schmorp/shell";
75
76	Then you can use a tool to connect to the shell, such as the ever
77	versatile C<socat>, which in addition can give you readline support:
78
79	socat readline /home/schmorp/shell
80	# or:
81	cd /home/schmorp; socat readline unix:shell
82
83	Socat can even give you a persistent history:
84
85	socat readline,history=.anyevent-history unix:shell
86
87	Binding on C<127.0.0.1> (or C<::1>) might be a less secure but sitll not
88	totally insecure (on single-user machines) alternative to let you use
89	other tools, such as telnet:
90
91	our $SHELL = AnyEvent::Debug::shell "127.1", "1357";
92
93	And then:
94
95	telnet localhost 1357
96
97	=cut
98
99	sub shell($$) {
100	local $TRACE = 0;
101
102	AnyEvent::Socket::tcp_server $_[0], $_[1], sub {
103	my ($fh, $host, $port) = @_;
104
105	syswrite $fh, "Welcome, $host:$port, use 'help' for more info!\015\012> ";
106	my $rbuf;
107
108	my $logger = new AnyEvent::Log::Ctx
109	log_cb => sub {
110	syswrite $fh, shift;
111	0
112	};
113
114	my $logger_guard = AnyEvent::Util::guard {
115	$AnyEvent::Log::COLLECT->detach ($logger);
116	};
117	$AnyEvent::Log::COLLECT->attach ($logger);
118
119	local $TRACE = 0;
120	my $rw; $rw = AE::io $fh, 0, sub {
121	my $len = sysread $fh, $rbuf, 1024, length $rbuf;
122
123	$logger_guard if 0; # reference it
124
125	if (defined $len ? $len == 0 : $! != Errno::EAGAIN) {
126	undef $rw;
127	} else {
128	while ($rbuf =~ s/^(.*)\015?\012//) {
129	my $line = $1;
130
131	AnyEvent::Util::fh_nonblocking $fh, 0;
132
133	if ($line =~ /^\s*exit\b/) {
134	syswrite $fh, "sorry, no... if you want to execute exit, try CORE::exit.\015\012";
135	} else {
136	package AnyEvent::Debug::shell;
137
138	no strict 'vars';
139	local $LOGGER = $logger;
140	my $old_stdout = select $fh;
141	local $\| = 1;
142
143	my @res = eval $line;
144
145	select $old_stdout;
146	syswrite $fh, "$@" if $@;
147	syswrite $fh, "\015\012";
148
149	if (@res > 1) {
150	syswrite $fh, "$_: $res[$_]\015\012" for 0 .. $#res;
151	} elsif (@res == 1) {
152	syswrite $fh, "$res[0]\015\012";
153	}
154	}
155
156	syswrite $fh, "> ";
157	AnyEvent::Util::fh_nonblocking $fh, 1;
158	}
159	}
160	};
161	}
162	}
163
164	{
165	package AnyEvent::Debug::shell;
166
167	our $LOGGER;
168
169	sub help() {
170	<<EOF
171	help this command
172	wr [level] sets wrap level to level (or toggles if missing)
173	v [level] sets verbosity (or toggles between 0 and 9 if missing)
174	wl 'regex' print wrapped watchers matching the regex (or all if missing)
175	i id,... prints the watcher with the given ids in more detail
176	t enable tracing for newly created watchers (enabled by default)
177	ut disable tracing for newly created watchers
178	t id,... enable tracing for the given watcher (enabled by default)
179	ut id,... disable tracing for the given watcher
180	w id,... converts the watcher ids to watcher objects (for scripting)
181	EOF
182	}
183
184	sub wl(;$) {
185	my $re = @_ ? qr<$_[0]>i : qr<.>;
186
187	my %res;
188
189	while (my ($k, $v) = each %AnyEvent::Debug::Wrapped) {
190	my $s = "$v";
191	$res{$s} = $k . (exists $v->{error} ? "*" : " ")
192	if $s =~ $re;
193	}
194
195	join "", map "$res{$_} $_\n", sort keys %res
196	}
197
198	sub w {
199	map {
200	$AnyEvent::Debug::Wrapped{$_} \|\| do {
201	print "$_: no such wrapped watcher.\n";
202	()
203	}
204	} @_
205	}
206
207	sub i {
208	join "",
209	map $_->id . " $_\n" . $_->verbose . "\n",
210	&w
211	}
212
213	sub wr {
214	AnyEvent::Debug::wrap (@_);
215
216	"wrap level now $AnyEvent::Debug::WRAP_LEVEL"
217	}
218
219	sub t {
220	if (@_) {
221	@_ = &w;
222	$_->trace (1)
223	for @_;
224	"tracing enabled for @_."
225	} else {
226	$AnyEvent::Debug::TRACE = 1;
227	"tracing for newly created watchers is now enabled."
228	}
229	}
230
231	sub u {
232	if (@_) {
233	@_ = &w;
234	$_->trace (0)
235	for @_;
236	"tracing disabled for @_."
237	} else {
238	$AnyEvent::Debug::TRACE = 0;
239	"tracing for newly created watchers is now disabled."
240	}
241	}
242
243	sub v {
244	$LOGGER->level (@_ ? $_[0] : $LOGGER->[1] ? 0 : 9);
245
246	"verbose logging is now " . ($LOGGER->[1] ? "enabled" : "disabled") . "."
247	}
248	}
249
250	=item AnyEvent::Debug::wrap [$level]
251
252	Sets the instrumenting/wrapping level of all watchers that are being
253	created after this call. If no C<$level> has been specified, then it
254	toggles between C<0> and C<1>.
255
256	The default wrap level is C<0>, or whatever
257	C<$ENV{PERL_ANYEVENT_DEBUG_WRAP}> specifies.
258
259	A level of C<0> disables wrapping, i.e. AnyEvent works normally, and in
260	its most efficient mode.
261
262	A level of C<1> or higher enables wrapping, which replaces all watchers
263	by AnyEvent::Debug::Wrapped objects, stores the location where a
264	watcher was created and wraps the callback to log all invocations at
265	"trace" loglevel if tracing is enabled fore the watcher. The initial
266	state of tracing when creating a watcher is taken from the global
267	variable C<$AnyEvent:Debug::TRACE>. The default value of that variable
268	is C<1>, but it can make sense to set it to C<0> and then do C<< local
269	$AnyEvent::Debug::TRACE = 1 >> in a block where you create "interesting"
270	watchers. Tracing can also be enabled and disabled later by calling the
271	watcher's C<trace> method.
272
273	The wrapper will also count how many times the callback was invoked and
274	will record up to ten runtime errors with corresponding backtraces. It
275	will also log runtime errors at "error" loglevel.
276
277	To see the trace messages, you can invoke your program with
278	C<PERL_ANYEVENT_VERBOSE=9>, or you can use AnyEvent::Log to divert
279	the trace messages in any way you like (the EXAMPLES section in
280	L<AnyEvent::Log> has some examples).
281
282	A level of C<2> does everything that level C<1> does, but also stores a
283	full backtrace of the location the watcher was created, which slows down
284	watcher creation considerably.
285
286	Every wrapped watcher will be linked into C<%AnyEvent::Debug::Wrapped>,
287	with its address as key. The C<wl> command in the debug shell can be used
288	to list watchers.
289
290	Instrumenting can increase the size of each watcher multiple times, and,
291	especially when backtraces are involved, also slows down watcher creation
292	a lot.
293
294	Also, enabling and disabling instrumentation will not recover the full
295	performance that you had before wrapping (the AE::xxx functions will stay
296	slower, for example).
297
298	If you are developing your program, also consider using AnyEvent::Strict
299	to check for common mistakes.
300
301	=cut
302
303	our $WRAP_LEVEL;
304	our $TRACE_CUR;
305	our $POST_DETECT;
306
307	sub wrap(;$) {
308	my $PREV_LEVEL = $WRAP_LEVEL;
309	$WRAP_LEVEL = @_ ? 0+shift : $WRAP_LEVEL ? 0 : 1;
310
311	if ($AnyEvent::MODEL) {
312	if ($WRAP_LEVEL && !$PREV_LEVEL) {
313	$TRACE_LOGGER = AnyEvent::Log::logger trace => \$TRACE_ENABLED;
314	AnyEvent::_isa_hook 0 => "AnyEvent::Debug::Wrap", 1;
315	AnyEvent::Debug::Wrap::_reset ();
316	} elsif (!$WRAP_LEVEL && $PREV_LEVEL) {
317	AnyEvent::_isa_hook 0 => undef;
318	}
319	} else {
320	$POST_DETECT \|\|= AnyEvent::post_detect {
321	undef $POST_DETECT;
322	return unless $WRAP_LEVEL;
323
324	(my $level, $WRAP_LEVEL) = ($WRAP_LEVEL, undef);
325
326	require AnyEvent::Strict unless $AnyEvent::Strict::VERSION;
327
328	AnyEvent::post_detect { # make sure we run after AnyEvent::Strict
329	wrap ($level);
330	};
331	};
332	}
333	}
334
335	=item AnyEvent::Debug::path2mod $path
336
337	Tries to replace a path (e.g. the file name returned by caller)
338	by a module name. Returns the path unchanged if it fails.
339
340	Example:
341
342	print AnyEvent::Debug::path2mod "/usr/lib/perl5/AnyEvent/Debug.pm";
343	# might print "AnyEvent::Debug"
344
345	=cut
346
347	sub path2mod($) {
348	keys %INC; # reset iterator
349
350	while (my ($k, $v) = each %INC) {
351	if ($_[0] eq $v) {
352	$k =~ s%/%::%g if $k =~ s/\.pm$//;
353	return $k;
354	}
355	}
356
357	my $path = shift;
358
359	$path =~ s%^\./%%;
360
361	$path
362	}
363
364	=item AnyEvent::Debug::cb2str $cb
365
366	Using various gambits, tries to convert a callback (e.g. a code reference)
367	into a more useful string.
368
369	Very useful if you debug a program and have some callback, but you want to
370	know where in the program the callback is actually defined.
371
372	=cut
373
374	sub cb2str($) {
375	my $cb = shift;
376
377	"CODE" eq ref $cb
378	or return "$cb";
379
380	eval {
381	my $cv = B::svref_2object ($cb);
382
383	my $gv = $cv->GV
384	or return "$cb";
385
386	my $name = $gv->NAME;
387
388	return (AnyEvent::Debug::path2mod $gv->FILE) . ":" . $gv->LINE
389	if $name eq "__ANON__";
390
391	$gv->STASH->NAME . "::" . $name;
392	} \|\| "$cb"
393	}
394
395	sub sv2str($) {
396	if (ref $_[0]) {
397	if (ref $_[0] eq "CODE") {
398	return "$_[0]=" . cb2str $_[0];
399	} else {
400	return "$_[0]";
401	}
402	} else {
403	for ("\'$_[0]\'") { # make copy
404	substr $_, $Carp::MaxArgLen, length, "'..."
405	if length > $Carp::MaxArgLen;
406	return $_;
407	}
408	}
409	}
410
411	=item AnyEvent::Debug::backtrace [$skip]
412
413	Creates a backtrace (actually an AnyEvent::Debug::Backtrace object
414	that you can stringify), not unlike the Carp module would. Unlike the
415	Carp module it resolves some references (such as callbacks) to more
416	user-friendly strings, has a more succinct output format and most
417	importantly: doesn't leak memory like hell.
418
419	The reason it creates an object is to save time, as formatting can be
420	done at a later time. Still, creating a backtrace is a relatively slow
421	operation.
422
423	=cut
424
425	sub backtrace(;$) {
426	my $w = shift;
427
428	my (@bt, @c);
429	my ($modlen, $sub);
430
431	for (;;) {
432	# 0 1 2 3 4 5 6 7 8 9 10
433	# ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash)
434	package DB;
435	@c = caller $w++
436	or last;
437	package AnyEvent::Debug; # no block for speed reasons
438
439	if ($c[7]) {
440	$sub = "require $c[6]";
441	} elsif (defined $c[6]) {
442	$sub = "eval \"\"";
443	} else {
444	$sub = ($c[4] ? "" : "&") . $c[3];
445
446	$sub .= "("
447	. (join ",",
448	map sv2str $DB::args[$_],
449	0 .. (@DB::args < $Carp::MaxArgNums ? @DB::args : $Carp::MaxArgNums) - 1)
450	. ")"
451	if $c[4];
452	}
453
454	push @bt, [\($STRCACHE{$c[1]} \|\|= $c[1]), $c[2], $sub];
455	}
456
457	@DB::args = ();
458
459	bless \@bt, "AnyEvent::Debug::Backtrace"
460	}
461
462	=back
463
464	=cut
465
466	package AnyEvent::Debug::Wrap;
467
468	use AnyEvent (); BEGIN { AnyEvent::common_sense }
469	use Scalar::Util ();
470	use Carp ();
471
472	sub _reset {
473	for my $name (qw(io timer signal child idle)) {
474	my $super = "SUPER::$name";
475
476	*$name = sub {
477	my ($self, %arg) = @_;
478
479	my $w;
480
481	my $t = $TRACE;
482
483	my ($pkg, $file, $line, $sub);
484
485	$w = 0;
486	do {
487	($pkg, $file, $line) = caller $w++;
488	} while $pkg =~ /^(?:AE\|AnyEvent::(?:Socket\|Handle\|Util\|Debug\|Strict\|Base\|CondVar\|CondVar::Base\|Impl::.*)\|Coro::AnyEvent::CondVar)$/;
489
490	$sub = (caller $w)[3];
491
492	my $cb = $arg{cb};
493	$arg{cb} = sub {
494	++$w->{called};
495
496	local $TRACE_CUR = $w;
497
498	$TRACE_LOGGER->("enter $w") if $TRACE_ENABLED && $t;
499	eval {
500	local $SIG{__DIE__} = sub {
501	die $_[0] . AnyEvent::Debug::backtrace
502	if defined $^S;
503	};
504	&$cb;
505	};
506	if ($@) {
507	my $err = "$@";
508	push @{ $w->{error} }, [AE::now, $err]
509	if @{ $w->{error} } < 10;
510	AE::log die => "($w) $err"
511	or warn "($w) $err";
512	}
513	$TRACE_LOGGER->("leave $w") if $TRACE_ENABLED && $t;
514	};
515
516	$self = bless {
517	type => $name,
518	w => $self->$super (%arg),
519	rfile => \($STRCACHE{$file} \|\|= $file),
520	line => $line,
521	sub => $sub,
522	cur => "$TRACE_CUR",
523	now => AE::now,
524	arg => \%arg,
525	cb => $cb,
526	called => 0,
527	rt => \$t,
528	}, "AnyEvent::Debug::Wrapped";
529
530	delete $arg{cb};
531
532	$self->{bt} = AnyEvent::Debug::backtrace 1
533	if $WRAP_LEVEL >= 2;
534
535	Scalar::Util::weaken ($w = $self);
536	Scalar::Util::weaken ($AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $self} = $self);
537
538	$TRACE_LOGGER->("creat $w") if $TRACE_ENABLED && $t;
539
540	$self
541	};
542	}
543	}
544
545	package AnyEvent::Debug::Wrapped;
546
547	=head1 THE AnyEvent::Debug::Wrapped CLASS
548
549	All watchers created while the wrap level is non-zero will be wrapped
550	inside an AnyEvent::Debug::Wrapped object. The address of the
551	wrapped watcher will become its ID - every watcher will be stored in
552	C<$AnyEvent::Debug::Wrapped{$id}>.
553
554	These wrapper objects can be stringified and have some methods defined on
555	them.
556
557	For debugging, of course, it can be helpful to look into these objects,
558	which is why this is documented here, but this might change at any time in
559	future versions.
560
561	Each object is a relatively standard hash with the following members:
562
563	type => name of the method used ot create the watcher (e.g. C<io>, C<timer>).
564	w => the actual watcher
565	rfile => reference to the filename of the file the watcher was created in
566	line => line number where it was created
567	sub => function name (or a special string) which created the watcher
568	cur => if created inside another watcher callback, this is the string rep of the other watcher
569	now => the timestamp (AE::now) when the watcher was created
570	arg => the arguments used to create the watcher (sans C<cb>)
571	cb => the original callback used to create the watcher
572	called => the number of times the callback was called
573
574	Each object supports the following mehtods (warning: these are only
575	available on wrapped watchers, so are best for interactive use via the
576	debug shell).
577
578	=over 4
579
580	=cut
581
582	use AnyEvent (); BEGIN { AnyEvent::common_sense }
583
584	use overload
585	'""' => sub {
586	$_[0]{str} \|\|= do {
587	my ($pkg, $line) = @{ $_[0]{caller} };
588
589	my $mod = AnyEvent::Debug::path2mod ${ $_[0]{rfile} };
590	my $sub = $_[0]{sub};
591
592	if (defined $sub) {
593	$sub =~ s/^\Q$mod\E:://;
594	$sub = "($sub)";
595	}
596
597	"$mod:$_[0]{line}$sub>$_[0]{type}>"
598	. (AnyEvent::Debug::cb2str $_[0]{cb})
599	};
600	},
601	fallback => 1,
602	;
603
604	=item $w->id
605
606	Returns the numerical id of the watcher, as used in the debug shell.
607
608	=cut
609
610	sub id {
611	Scalar::Util::refaddr shift
612	}
613
614	=item $w->verbose
615
616	Returns a multiline textual description of the watcher, including the
617	first ten exceptions caught while executing the callback.
618
619	=cut
620
621	sub verbose {
622	my ($self) = @_;
623
624	my $res = "type: $self->{type} watcher\n"
625	. "args: " . (join " ", %{ $self->{arg} }) . "\n" # TODO: decode fh?
626	. "created: " . (AnyEvent::Log::ft $self->{now}) . " ($self->{now})\n"
627	. "file: ${ $self->{rfile} }\n"
628	. "line: $self->{line}\n"
629	. "subname: $self->{sub}\n"
630	. "context: $self->{cur}\n"
631	. "tracing: " . (${ $self->{rt} } ? "enabled" : "disabled") . "\n"
632	. "cb: $self->{cb} (" . (AnyEvent::Debug::cb2str $self->{cb}) . ")\n"
633	. "invoked: $self->{called} times\n";
634
635	if (exists $self->{bt}) {
636	$res .= "created\n$self->{bt}";
637	}
638
639	if (exists $self->{error}) {
640	$res .= "errors: " . @{$self->{error}} . "\n";
641
642	$res .= "error: " . (AnyEvent::Log::ft $_->[0]) . " ($_->[0]) $_->[1]\n"
643	for @{$self->{error}};
644	}
645
646	$res
647	}
648
649	=item $w->trace ($on)
650
651	Enables (C<$on> is true) or disables (C<$on> is false) tracing on this
652	watcher.
653
654	To get tracing messages, both the global logging settings must have trace
655	messages enabled for the context C<AnyEvent::Debug> and tracing must be
656	enabled for the wrapped watcher.
657
658	To enable trace messages globally, the simplest way is to start the
659	program with C<PERL_ANYEVENT_VERBOSE=9> in the environment.
660
661	Tracing for each individual watcher is enabled by default (unless
662	C<$AnyEvent::Debug::TRACE> has been set to false).
663
664	=cut
665
666	sub trace {
667	${ $_[0]{rt} } = $_[1];
668	}
669
670	sub DESTROY {
671	$TRACE_LOGGER->("dstry $_[0]") if $TRACE_ENABLED && ${ $_[0]{rt} };
672
673	delete $AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $_[0]};
674	}
675
676	=back
677
678	=cut
679
680	package AnyEvent::Debug::Backtrace;
681
682	use AnyEvent (); BEGIN { AnyEvent::common_sense }
683
684	sub as_string {
685	my ($self) = @_;
686
687	my @bt;
688	my $modlen;
689
690	for (@$self) {
691	my ($rpath, $line, $sub) = @$_;
692
693	$rpath = (AnyEvent::Debug::path2mod $$rpath) . " line $line";
694	$modlen = length $rpath if $modlen < length $rpath;
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
701	push @bt, [$rpath, $sub];
702	}
703
704	join "",
705	map { sprintf "%*s %s\n", -$modlen, $_->[0], $_->[1] }
706	@bt
707	}
708
709	use overload
710	'""' => \&as_string,
711	fallback => 1,
712	;
713
714	=head1 AUTHOR
715
716	Marc Lehmann <schmorp@schmorp.de>
717	http://anyevent.schmorp.de
718
719	=cut
720
721	1
722