ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Debug.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Debug.pm (file contents):
Revision 1.3 by root, Thu Jul 30 03:41:56 2009 UTC vs.
Revision 1.4 by root, Sat Aug 13 02:20:29 2011 UTC

… …
33use AnyEvent::Socket (); 33use AnyEvent::Socket ();
34 34
35=item $shell = AnyEvent;::Debug::shell $host, $service 35=item $shell = AnyEvent;::Debug::shell $host, $service
36 36
37This function binds on the given host and service port and returns a 37This function binds on the given host and service port and returns a
38shell object, whcih determines the lifetime of the shell. Any number 38shell object, which determines the lifetime of the shell. Any number
39of conenctions are accepted on the port, and they will give you a very 39of conenctions are accepted on the port, and they will give you a very
40primitive shell that simply executes every line you enter. 40primitive shell that simply executes every line you enter.
41 41
42All commands will be executed "blockingly" with the socket C<select>ed for 42All commands will be executed "blockingly" with the socket C<select>ed for
43output. For a less "blocking" interface see L<Coro::Debug>. 43output. For a less "blocking" interface see L<Coro::Debug>.
… …
51internal variables inside C<my> variables, so users couldn't accidentally 51internal variables inside C<my> variables, so users couldn't accidentally
52access them. Having interactive access to your programs changed that: 52access them. Having interactive access to your programs changed that:
53having internal variables still in the global scope means you can debug 53having internal variables still in the global scope means you can debug
54them easier. 54them easier.
55 55
56As no authenticsation is done, in most cases it is best not to use a TCP 56As no authentication is done, in most cases it is best not to use a TCP
57port, but a unix domain socket, whcih cna be put wherever youc an access 57port, but a unix domain socket, whcih can be put wherever you can access
58it, but not others: 58it, but not others:
59 59
60 our $SHELL = AnyEvent::Debug::shell "unix/", "/home/schmorp/shell"; 60 our $SHELL = AnyEvent::Debug::shell "unix/", "/home/schmorp/shell";
61 61
62Then you can use a tool to connect to the shell, such as the ever 62Then you can use a tool to connect to the shell, such as the ever
… …
127 } 127 }
128 }; 128 };
129 } 129 }
130} 130}
131 131
132=item AnyEvent::Debug::wrap [$level]
133
134Sets the instrumenting/wrapping level of all watchers that are being
135created after this call. If no C<$level> has been specified, then it
136toggles between C<0> and C<1>.
137
138A level of C<0> disables wrapping, i.e. AnyEvent works normally, and in
139its most efficient mode.
140
141A level of C<1> enables wrapping, which replaces all watchers by
142AnyEvent::Debug::Wrapped objects, stores the location where a watcher was
143created and wraps the callback so invocations of it can be traced.
144
145A level of C<2> does everything that level C<1> does, but also stores a
146full backtrace of the location the watcher was created.
147
148Instrumenting can increase the size of each watcher multiple times, and,
149especially when backtraces are involved, also slows down watcher creation
150a lot.
151
152Also, enabling and disabling instrumentation will not recover the full
153performance that you had before wrapping (the AE::xxx functions will stay
154slower, for example).
155
156Currently, enabling wrapping will also load AnyEvent::Strict, but this is
157not be relied upon.
158
159=cut
160
161our $WRAP_LEVEL;
162our $TRACE_LEVEL = 2;
163our $TRACE_NEST = 0;
164our $TRACE_CUR;
165our $POST_DETECT;
166
167sub wrap(;$) {
168 my $PREV_LEVEL = $WRAP_LEVEL;
169 $WRAP_LEVEL = @_ ? 0+shift : $WRAP_LEVEL ? 0 : 1;
170
171 if (defined $AnyEvent::MODEL) {
172 unless (defined $PREV_LEVEL) {
173 AnyEvent::Debug::Wrapped::_init ();
174 }
175
176 if ($WRAP_LEVEL && !$PREV_LEVEL) {
177 require AnyEvent::Strict;
178 @AnyEvent::Debug::Wrap::ISA = @AnyEvent::ISA;
179 @AnyEvent::ISA = "AnyEvent::Debug::Wrap";
180 AE::_reset;
181 AnyEvent::Debug::Wrap::_reset ();
182 } elsif (!$WRAP_LEVEL && $PREV_LEVEL) {
183 @AnyEvent::ISA = @AnyEvent::Debug::Wrap::ISA;
184 }
185 } else {
186 $POST_DETECT ||= AnyEvent::post_detect {
187 undef $POST_DETECT;
188 return unless $WRAP_LEVEL;
189
190 (my $level, $WRAP_LEVEL) = ($WRAP_LEVEL, undef);
191
192 require AnyEvent::Strict;
193
194 AnyEvent::post_detect { # make sure we run after AnyEvent::Strict
195 wrap ($level);
196 };
197 };
198 }
199}
200
201=item AnyEvent::Debug::path2mod $path
202
203Tries to replace a path (e.g. the file name returned by caller)
204by a module name. Returns the path unchanged if it fails.
205
206Example:
207
208 print AnyEvent::Debug::path2mod "/usr/lib/perl5/AnyEvent/Debug.pm";
209 # might print "AnyEvent::Debug"
210
211=cut
212
213sub path2mod($) {
214 keys %INC; # reset iterator
215
216 while (my ($k, $v) = each %INC) {
217 if ($_[0] eq $v) {
218 $k =~ s%/%::%g if $k =~ s/\.pm$//;
219 return $k;
220 }
221 }
222
223 my $path = shift;
224
225 $path =~ s%^\./%%;
226
227 $path
228}
229
230=item AnyEvent::Debug::cb2str $cb
231
232Using various gambits, tries to convert a callback (e.g. a code reference)
233into a more useful string.
234
235Very useful if you debug a program and have some callback, but you want to
236know where in the program the callbakc is actually defined.
237
238=cut
239
240sub cb2str($) {
241 my $cb = shift;
242
243 require B;
244
245 "CODE" eq ref $cb
246 or return "$cb";
247
248 my $cv = B::svref_2object ($cb);
249
250 my $gv = $cv->GV
251 or return "$cb";
252
253 return (AnyEvent::Debug::path2mod $gv->FILE) . ":" . $gv->LINE
254 if $gv->NAME eq "__ANON__";
255
256 return $gv->STASH->NAME . "::" . $gv->NAME;
257}
258
259package AnyEvent::Debug::Wrap;
260
261use AnyEvent (); BEGIN { AnyEvent::common_sense }
262use Scalar::Util ();
263use Carp ();
264
265sub _reset {
266 for my $name (qw(io timer signal child idle)) {
267 my $super = "SUPER::$name";
268
269 *$name = sub {
270 my ($self, %arg) = @_;
271
272 my $w;
273
274 my ($pkg, $file, $line, $sub);
275
276 $w = 0;
277 do {
278 ($pkg, $file, $line) = caller $w++;
279 } while $pkg =~ /^(?:AE|AnyEvent::Socket|AnyEvent::Util|AnyEvent::Debug|AnyEvent::Strict)$/;
280
281 $sub = (caller $w++)[3];
282
283 my $cb = $arg{cb};
284 $arg{cb} = sub {
285 return &$cb
286 unless $TRACE_LEVEL;
287
288 local $TRACE_NEST = $TRACE_NEST + 1;
289 local $TRACE_CUR = "$w";
290 print "$TRACE_NEST enter $TRACE_CUR\n" if $TRACE_LEVEL;
291 eval {
292 local $SIG{__DIE__};
293 &$cb;
294 };
295 if ($@) {
296 print "$TRACE_NEST ERROR $TRACE_CUR $@";
297 }
298 print "$TRACE_NEST leave $TRACE_CUR\n" if $TRACE_LEVEL;
299 };
300
301 $self = bless {
302 type => $name,
303 w => $self->$super (%arg),
304 file => $file,
305 line => $line,
306 sub => $sub,
307 cur => $TRACE_CUR,
308 cb => $cb,
309 }, "AnyEvent::Debug::Wrapped";
310
311 $w->{bt} = Carp::longmess ""
312 if $WRAP_LEVEL >= 2;
313
314 Scalar::Util::weaken ($w = $self);
315 Scalar::Util::weaken ($AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $self} = $self);
316
317 print "$TRACE_NEST creat $w\n" if $TRACE_LEVEL;
318
319 $self
320 };
321 }
322}
323
324package AnyEvent::Debug::Wrapped;
325
326use AnyEvent (); BEGIN { AnyEvent::common_sense }
327
328sub _init {
329 require overload;
330 import overload
331 '""' => sub {
332 $_[0]{str} ||= do {
333 my ($pkg, $line) = @{ $_[0]{caller} };
334
335 ($_[0]{cur} ? "$_[0]{cur}/" : "")
336 . (AnyEvent::Debug::path2mod $_[0]{file})
337 .":"
338 . $_[0]{line}
339 . ($_[0]{sub} =~ /^[^(]/ ? "($_[0]{sub})" : "")
340 . ">"
341 . $_[0]{type}
342 . ">"
343 . (AnyEvent::Debug::cb2str $_[0]{cb})
344 };
345 },
346 fallback => 1;
347}
348
349sub DESTROY {
350 print "$TRACE_NEST dstry $_[0]\n" if $TRACE_LEVEL;
351
352 delete $AnyEvent::Debug::Wrapped{Scalar::Util::refaddr $_[0]};
353}
354
1321; 3551;
133 356
134=back 357=back
135 358
136=head1 AUTHOR 359=head1 AUTHOR

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines