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 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 weatcher
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 cna 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;

         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;

   require B;

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

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

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

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

   return $gv->STASH->NAME . "::" . $gv->NAME;
}

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 (euch 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 ($@) {
               push @{ $w->{error} }, [AE::now, "$@"]
                  if @{ $w->{error} } < 10;
               AE::log die => "($w) $@"
                  or warn "($w) $@";
            }
            $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;

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

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

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

1;

=head1 AUTHOR

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

=cut

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