Try this. Save it as yourperl/site/lib/Devel/Trace/Remote.pm
Updated: Improved the cleanup to allow reconnects.
ppackage Devel::Trace::Remote;
use strict;
use warnings;
use IO::Socket;
use threads;
use threads::shared;
use Thread::Queue;
my $connected :shared = 0;
my $Q = new Thread::Queue;
sub DB::DB {
return unless $connected;
$Q->enqueue( join ' : ', caller );
return;
}
async {
my $server = IO::Socket::INET->new(
LocalHost => 'localhost:54321',
Listen => 1,
Reuse => 1,
) or die $!;
$server->autoflush;
while( my $client = $server->accept ) {
$connected = 1;
while( $_ = $Q->dequeue ) {
print $client "$_\n\r" or last;
};
$connected = 0;
$Q->dequeue while $Q->pending;
}
}->detach;
1;
Then start your script using perl -d:Trace::Remote yourscript. When things start going awry, telnet into localhost:54321 and you will get output along the lines of:
##pkg file lineno
main : ack1.pl : 21
main : ack1.pl : 22
main : ack1.pl : 21
main : ack1.pl : 22
main : ack1.pl : 21
main : ack1.pl : 22
main : ack1.pl : 21
main : ack1.pl : 22
main : ack1.pl : 21
main : ack1.pl : 22
main : ack1.pl : 21
main : ack1.pl : 22
main : ack1.pl : 21
main : ack1.pl : 22
main : ack1.pl : 21
main : ack1.pl : 22
main : ack1.pl : 21
With nothing connected, it will have minimal impact on the process. (For cpu-bound processes about 4 1/2 times slower. Much less for a IO-bound process. When you are connected, expect the slowdown to roughly double.) You may also see some memory growth if the program is is a tight loop (generating output faster than telnet can receive it.
Many enhancements are possible, but this should allow you to get a feel for what is going on inside the code without to much impact on the normal running. It may end up on CPAN if you find it useful.
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
|