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 Errno ();
use POSIX ();

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

=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", "wl" and "wlv" commands, and can be freely
modified by all shells. Code is evaluated under C<use strict 'subs'>.

Consider the beneficial aspects of using more global (our) variables than
local ones (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($$) {
   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 $rw; $rw = AE::io $fh, 0, sub {
         my $len = sysread $fh, $rbuf, 1024, length $rbuf;

         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';
                  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;

   sub help() {
      <<EOF
help         this command
wr [level]   sets wrap level to level (or toggles if missing)
t [level]    sets trace level (or toggles if missing)
wl 'regex'   print wrapped watchers matching the regex (or all if missing)
w id,...     prints the watcher with the given ids in more detail
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(@) {
      my $res;

      for my $id (@_) {
         if (my $w = $AnyEvent::Debug::Wrapped{$id}) {
            $res .= "$id $w\n" . $w->verbose;
         } else {
            $res .= "$id: no such wrapped watcher.\n";
         }
      }

      $res
   }

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

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

   sub t {
      $AnyEvent::Debug::TRACE_LEVEL = @_ ? shift : $AnyEvent::Debug::TRACE_LEVEL ? 0 : 9;

      "trace level now $AnyEvent::Debug::TRACE_LEVEL"
   }
}

=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> enables wrapping, which replaces all watchers by
AnyEvent::Debug::Wrapped objects, stores the location where a watcher was
created and wraps the callback so invocations of it can be traced.

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.

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_LEVEL;
our $TRACE_CUR;
our $POST_DETECT;

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

   if (defined $AnyEvent::MODEL) {
      unless (defined $PREV_LEVEL) {
         AnyEvent::Debug::Wrapped::_init ();
      }

      if ($WRAP_LEVEL && !$PREV_LEVEL) {
         AnyEvent::_isa_hook 1 => "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 callbakc 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;
}

# Format Time, not public - yet?
sub ft($) {
   my $t = shift;
   my $i = int $t;
   my $f = sprintf "%06d", 1e6 * ($t - $i);

   POSIX::strftime "%Y-%m-%d %H:%M:%S.$f %z", localtime $i
}

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 ($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::.*))$/;

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

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

            return &$cb
               unless $TRACE_LEVEL;

            local $TRACE_CUR  = "$w";
            print AnyEvent::Debug::ft AE::now, " enter $TRACE_CUR\n" if $TRACE_LEVEL;
            eval {
               local $SIG{__DIE__} = sub { die Carp::longmess "$_[0]Backtrace starting" };
               &$cb;
            };
            if ($@) {
               push @{ $w->{error} }, [AE::now, $@]
                  if @{ $w->{error} } < 10;
               print AnyEvent::Debug::ft AE::now, " ERROR $TRACE_CUR $@";
            }
            print AnyEvent::Debug::ft AE::now, " leave $TRACE_CUR\n" if $TRACE_LEVEL;
         };

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

         delete $arg{cb};

         # backtraces leak like hell
         $self->{bt} = Carp::longmess ""
            if $WRAP_LEVEL >= 2;

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

         print AnyEvent::Debug::ft AE::now, " creat $w\n" if $TRACE_LEVEL;

         $self
      };
   }
}

package AnyEvent::Debug::Wrapped;

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

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

            my $mod = AnyEvent::Debug::path2mod $_[0]{file};
            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;
}

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

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

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

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

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

   $res
}

sub DESTROY {
   print AnyEvent::Debug::ft AE::now, " dstry $_[0]\n" if $TRACE_LEVEL;

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

1;

=back

=head1 AUTHOR

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

=cut

Revision:	1.15
Committed:	Mon Aug 15 12:56:53 2011 UTC (12 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.14:	+2 -2 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 Errno ();
30	use POSIX ();
31
32	use AnyEvent (); BEGIN { AnyEvent::common_sense }
33	use AnyEvent::Util ();
34	use AnyEvent::Socket ();
35
36	=item $shell = AnyEvent;::Debug::shell $host, $service
37
38	This function binds on the given host and service port and returns a
39	shell object, which determines the lifetime of the shell. Any number
40	of conenctions are accepted on the port, and they will give you a very
41	primitive shell that simply executes every line you enter.
42
43	All commands will be executed "blockingly" with the socket C<select>ed for
44	output. For a less "blocking" interface see L<Coro::Debug>.
45
46	The commands will be executed in the C<AnyEvent::Debug::shell> package,
47	which currently has "help", "wl" and "wlv" commands, and can be freely
48	modified by all shells. Code is evaluated under C<use strict 'subs'>.
49
50	Consider the beneficial aspects of using more global (our) variables than
51	local ones (my) in package scope: Earlier all my modules tended to hide
52	internal variables inside C<my> variables, so users couldn't accidentally
53	access them. Having interactive access to your programs changed that:
54	having internal variables still in the global scope means you can debug
55	them easier.
56
57	As no authentication is done, in most cases it is best not to use a TCP
58	port, but a unix domain socket, whcih can be put wherever you can access
59	it, but not others:
60
61	our $SHELL = AnyEvent::Debug::shell "unix/", "/home/schmorp/shell";
62
63	Then you can use a tool to connect to the shell, such as the ever
64	versatile C<socat>, which in addition can give you readline support:
65
66	socat readline /home/schmorp/shell
67	# or:
68	cd /home/schmorp; socat readline unix:shell
69
70	Socat can even give you a persistent history:
71
72	socat readline,history=.anyevent-history unix:shell
73
74	Binding on C<127.0.0.1> (or C<::1>) might be a less secure but sitll not
75	totally insecure (on single-user machines) alternative to let you use
76	other tools, such as telnet:
77
78	our $SHELL = AnyEvent::Debug::shell "127.1", "1357";
79
80	And then:
81
82	telnet localhost 1357
83
84	=cut
85
86	sub shell($$) {
87	AnyEvent::Socket::tcp_server $_[0], $_[1], sub {
88	my ($fh, $host, $port) = @_;
89
90	syswrite $fh, "Welcome, $host:$port, use 'help' for more info!\015\012> ";
91	my $rbuf;
92	my $rw; $rw = AE::io $fh, 0, sub {
93	my $len = sysread $fh, $rbuf, 1024, length $rbuf;
94
95	if (defined $len ? $len == 0 : $! != Errno::EAGAIN) {
96	undef $rw;
97	} else {
98	while ($rbuf =~ s/^(.*)\015?\012//) {
99	my $line = $1;
100
101	AnyEvent::Util::fh_nonblocking $fh, 0;
102
103	if ($line =~ /^\s*exit\b/) {
104	syswrite $fh, "sorry, no... if you want to execute exit, try CORE::exit.\015\012";
105	} else {
106	package AnyEvent::Debug::shell;
107
108	no strict 'vars';
109	my $old_stdout = select $fh;
110	local $\| = 1;
111
112	my @res = eval $line;
113
114	select $old_stdout;
115	syswrite $fh, "$@" if $@;
116	syswrite $fh, "\015\012";
117
118	if (@res > 1) {
119	syswrite $fh, "$_: $res[$_]\015\012" for 0 .. $#res;
120	} elsif (@res == 1) {
121	syswrite $fh, "$res[0]\015\012";
122	}
123	}
124
125	syswrite $fh, "> ";
126	AnyEvent::Util::fh_nonblocking $fh, 1;
127	}
128	}
129	};
130	}
131	}
132
133	{
134	package AnyEvent::Debug::shell;
135
136	sub help() {
137	<<EOF
138	help this command
139	wr [level] sets wrap level to level (or toggles if missing)
140	t [level] sets trace level (or toggles if missing)
141	wl 'regex' print wrapped watchers matching the regex (or all if missing)
142	w id,... prints the watcher with the given ids in more detail
143	EOF
144	}
145
146	sub wl(;$) {
147	my $re = @_ ? qr<$_[0]>i : qr<.>;
148
149	my %res;
150
151	while (my ($k, $v) = each %AnyEvent::Debug::Wrapped) {
152	my $s = "$v";
153	$res{$s} = $k . (exists $v->{error} ? "*" : " ")
154	if $s =~ $re;
155	}
156
157	join "", map "$res{$_} $_\n", sort keys %res
158	}
159
160	sub w(@) {
161	my $res;
162
163	for my $id (@_) {
164	if (my $w = $AnyEvent::Debug::Wrapped{$id}) {
165	$res .= "$id $w\n" . $w->verbose;
166	} else {
167	$res .= "$id: no such wrapped watcher.\n";
168	}
169	}
170
171	$res
172	}
173
174	sub wr {
175	AnyEvent::Debug::wrap (@_);
176
177	"wrap level now $AnyEvent::Debug::WRAP_LEVEL"
178	}
179
180	sub t {
181	$AnyEvent::Debug::TRACE_LEVEL = @_ ? shift : $AnyEvent::Debug::TRACE_LEVEL ? 0 : 9;
182
183	"trace level now $AnyEvent::Debug::TRACE_LEVEL"
184	}
185	}
186
187	=item AnyEvent::Debug::wrap [$level]
188
189	Sets the instrumenting/wrapping level of all watchers that are being
190	created after this call. If no C<$level> has been specified, then it
191	toggles between C<0> and C<1>.
192
193	The default wrap level is C<0>, or whatever
194	C<$ENV{PERL_ANYEVENT_DEBUG_WRAP}> specifies.
195
196	A level of C<0> disables wrapping, i.e. AnyEvent works normally, and in
197	its most efficient mode.
198
199	A level of C<1> enables wrapping, which replaces all watchers by
200	AnyEvent::Debug::Wrapped objects, stores the location where a watcher was
201	created and wraps the callback so invocations of it can be traced.
202
203	A level of C<2> does everything that level C<1> does, but also stores a
204	full backtrace of the location the watcher was created.
205
206	Every wrapped watcher will be linked into C<%AnyEvent::Debug::Wrapped>,
207	with its address as key. The C<wl> command in the debug shell cna be used
208	to list watchers.
209
210	Instrumenting can increase the size of each watcher multiple times, and,
211	especially when backtraces are involved, also slows down watcher creation
212	a lot.
213
214	Also, enabling and disabling instrumentation will not recover the full
215	performance that you had before wrapping (the AE::xxx functions will stay
216	slower, for example).
217
218	If you are developing your program, also consider using AnyEvent::Strict
219	to check for common mistakes.
220
221	=cut
222
223	our $WRAP_LEVEL;
224	our $TRACE_LEVEL;
225	our $TRACE_CUR;
226	our $POST_DETECT;
227
228	sub wrap(;$) {
229	my $PREV_LEVEL = $WRAP_LEVEL;
230	$WRAP_LEVEL = @_ ? 0+shift : $WRAP_LEVEL ? 0 : 1;
231
232	if (defined $AnyEvent::MODEL) {
233	unless (defined $PREV_LEVEL) {
234	AnyEvent::Debug::Wrapped::_init ();
235	}
236
237	if ($WRAP_LEVEL && !$PREV_LEVEL) {
238	AnyEvent::_isa_hook 1 => "AnyEvent::Debug::Wrap", 1;
239	AnyEvent::Debug::Wrap::_reset ();
240	} elsif (!$WRAP_LEVEL && $PREV_LEVEL) {
241	AnyEvent::_isa_hook 0 => undef;
242	}
243	} else {
244	$POST_DETECT \|\|= AnyEvent::post_detect {
245	undef $POST_DETECT;
246	return unless $WRAP_LEVEL;
247
248	(my $level, $WRAP_LEVEL) = ($WRAP_LEVEL, undef);
249
250	require AnyEvent::Strict;
251
252	AnyEvent::post_detect { # make sure we run after AnyEvent::Strict
253	wrap ($level);
254	};
255	};
256	}
257	}
258
259	=item AnyEvent::Debug::path2mod $path
260
261	Tries to replace a path (e.g. the file name returned by caller)
262	by a module name. Returns the path unchanged if it fails.
263
264	Example:
265
266	print AnyEvent::Debug::path2mod "/usr/lib/perl5/AnyEvent/Debug.pm";
267	# might print "AnyEvent::Debug"
268
269	=cut
270
271	sub path2mod($) {
272	keys %INC; # reset iterator
273
274	while (my ($k, $v) = each %INC) {
275	if ($_[0] eq $v) {
276	$k =~ s%/%::%g if $k =~ s/\.pm$//;
277	return $k;
278	}
279	}
280
281	my $path = shift;
282
283	$path =~ s%^\./%%;
284
285	$path
286	}
287
288	=item AnyEvent::Debug::cb2str $cb
289
290	Using various gambits, tries to convert a callback (e.g. a code reference)
291	into a more useful string.
292
293	Very useful if you debug a program and have some callback, but you want to
294	know where in the program the callbakc is actually defined.
295
296	=cut
297
298	sub cb2str($) {
299	my $cb = shift;
300
301	require B;
302
303	"CODE" eq ref $cb
304	or return "$cb";
305
306	my $cv = B::svref_2object ($cb);
307
308	my $gv = $cv->GV
309	or return "$cb";
310
311	return (AnyEvent::Debug::path2mod $gv->FILE) . ":" . $gv->LINE
312	if $gv->NAME eq "__ANON__";
313
314	return $gv->STASH->NAME . "::" . $gv->NAME;
315	}
316
317	# Format Time, not public - yet?
318	sub ft($) {
319	my $t = shift;
320	my $i = int $t;
321	my $f = sprintf "%06d", 1e6 * ($t - $i);
322
323	POSIX::strftime "%Y-%m-%d %H:%M:%S.$f %z", localtime $i
324	}
325
326	package AnyEvent::Debug::Wrap;
327
328	use AnyEvent (); BEGIN { AnyEvent::common_sense }
329	use Scalar::Util ();
330	use Carp ();
331
332	sub _reset {
333	for my $name (qw(io timer signal child idle)) {
334	my $super = "SUPER::$name";
335
336	*$name = sub {
337	my ($self, %arg) = @_;
338
339	my $w;
340
341	my ($pkg, $file, $line, $sub);
342
343	$w = 0;
344	do {
345	($pkg, $file, $line) = caller $w++;
346	} while $pkg =~ /^(?:AE\|AnyEvent::(?:Socket\|Handle\|Util\|Debug\|Strict\|Base\|CondVar\|CondVar::Base\|Impl::.*))$/;
347
348	$sub = (caller $w++)[3];
349
350	my $cb = $arg{cb};
351	$arg{cb} = sub {
352	++$w->{called};
353
354	return &$cb
355	unless $TRACE_LEVEL;
356
357	local $TRACE_CUR = "$w";
358	print AnyEvent::Debug::ft AE::now, " enter $TRACE_CUR\n" if $TRACE_LEVEL;
359	eval {
360	local $SIG{__DIE__} = sub { die Carp::longmess "$_[0]Backtrace starting" };
361	&$cb;
362	};
363	if ($@) {
364	push @{ $w->{error} }, [AE::now, $@]
365	if @{ $w->{error} } < 10;
366	print AnyEvent::Debug::ft AE::now, " ERROR $TRACE_CUR $@";
367	}
368	print AnyEvent::Debug::ft AE::now, " leave $TRACE_CUR\n" if $TRACE_LEVEL;
369	};
370
371	$self = bless {
372	type => $name,
373	w => $self->$super (%arg),
374	file => $file,
375	line => $line,
376	sub => $sub,
377	cur => $TRACE_CUR,
378	now => AE::now,
379	arg => \%arg,
380	cb => $cb,
381	called => 0,
382	}, "AnyEvent::Debug::Wrapped";
383
384	delete $arg{cb};
385
386	# backtraces leak like hell
387	$self->{bt} = Carp::longmess ""
388	if $WRAP_LEVEL >= 2;
389
390	Scalar::Util::weaken ($w = $self);
391	Scalar::Util::weaken ($AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $self} = $self);
392
393	print AnyEvent::Debug::ft AE::now, " creat $w\n" if $TRACE_LEVEL;
394
395	$self
396	};
397	}
398	}
399
400	package AnyEvent::Debug::Wrapped;
401
402	use AnyEvent (); BEGIN { AnyEvent::common_sense }
403
404	sub _init {
405	require overload;
406	import overload
407	'""' => sub {
408	$_[0]{str} \|\|= do {
409	my ($pkg, $line) = @{ $_[0]{caller} };
410
411	my $mod = AnyEvent::Debug::path2mod $_[0]{file};
412	my $sub = $_[0]{sub};
413
414	if (defined $sub) {
415	$sub =~ s/^\Q$mod\E:://;
416	$sub = "($sub)";
417	}
418
419	"$mod:$_[0]{line}$sub>$_[0]{type}>"
420	. (AnyEvent::Debug::cb2str $_[0]{cb})
421	};
422	},
423	fallback => 1;
424	}
425
426	sub verbose {
427	my ($self) = @_;
428
429	my $res = "type: $self->{type} watcher\n"
430	. "args: " . (join " ", %{ $self->{arg} }) . "\n" # TODO: decode fh?
431	. "created: " . (AnyEvent::Debug::ft $self->{now}) . " ($self->{now})\n"
432	. "file: $self->{file}\n"
433	. "line: $self->{line}\n"
434	. "subname: $self->{sub}\n"
435	. "context: $self->{cur}\n"
436	. "cb: $self->{cb} (" . (AnyEvent::Debug::cb2str $self->{cb}) . ")\n"
437	. "invoked: $self->{called} times\n";
438
439	if (exists $self->{bt}) {
440	$res .= "created$self->{bt}";
441	}
442
443	if (exists $self->{error}) {
444	$res .= "errors: " . @{$self->{error}} . "\n";
445
446	$res .= "error: " . (AnyEvent::Debug::ft $_->[0]) . " ($_->[0]) $_->[1]\n"
447	for @{$self->{error}};
448	}
449
450	$res
451	}
452
453	sub DESTROY {
454	print AnyEvent::Debug::ft AE::now, " dstry $_[0]\n" if $TRACE_LEVEL;
455
456	delete $AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $_[0]};
457	}
458
459	1;
460
461	=back
462
463	=head1 AUTHOR
464
465	Marc Lehmann <schmorp@schmorp.de>
466	http://home.schmorp.de/
467
468	=cut
469