comment on

I just knocked up a crude trace monitor based around a threaded, tcp server receiving trace information from DB::DB based, per thread clients.

Here's a sample of trace from 2 copies of a multi-threaded test app I had kicking around that are each running 100 threads:

# hires timestamp pid  tid  script       lineno  package         subro
+utine args
1144302961.37707  3168( 38) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.29688  3216( 41) threadtest.pl(   29) (eval): n/a
1144302961.29714  3216( 41) threadtest.pl(   29) (eval): n/a
1144302961.29730  3216( 41) threadtest.pl(   29) (eval): n/a
1144302961.29743  3216( 41) threadtest.pl(   29) (eval): n/a
1144302961.29756  3216( 41) threadtest.pl(   29) (eval): n/a
1144302961.29769  3216( 41) threadtest.pl(   16) Win32::Console::Write
+Char: n/a
1144302961.29782  3216( 41) threadtest.pl(   16) Win32::Console::Write
+Char: n/a
1144302961.29795  3216( 41) threadtest.pl(   16) Win32::Console::Write
+Char: n/a
1144302961.29818  3216( 41) threadtest.pl(   29) (eval): n/a
1144302961.35938  3216(  0) (     ) : n/a
1144302961.35980  3216(  0) (     ) : n/a
1144302961.40625  3216( 42) threadtest.pl(   29) (eval): n/a
1144302961.40652  3216( 42) threadtest.pl(   29) (eval): n/a
1144302961.40668  3216( 42) threadtest.pl(   29) (eval): n/a
1144302961.40681  3216( 42) threadtest.pl(   29) (eval): n/a
1144302961.40694  3216( 42) threadtest.pl(   29) (eval): n/a
1144302961.40706  3216( 42) threadtest.pl(   16) Win32::Console::Write
+Char: n/a
1144302961.40719  3216( 42) threadtest.pl(   16) Win32::Console::Write
+Char: n/a
1144302961.40732  3216( 42) threadtest.pl(   16) Win32::Console::Write
+Char: n/a
1144302961.40754  3216( 42) threadtest.pl(   29) (eval): n/a
1144302961.49839  3168( 38) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.49881  3168( 38) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.49897  3168( 38) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50139  3168( 28) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50156  3168( 28) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50169  3168( 28) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50000  3168( 31) threadtest.pl(   29) (eval): n/a
1144302961.50016  3168( 31) threadtest.pl(   29) (eval): n/a
1144302961.50028  3168( 31) threadtest.pl(   29) (eval): n/a
1144302961.50041  3168( 31) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50054  3168( 31) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50066  3168( 31) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50000  3168(  7) threadtest.pl(   29) (eval): n/a
1144302961.50016  3168(  7) threadtest.pl(   29) (eval): n/a
1144302961.50028  3168(  7) threadtest.pl(   29) (eval): n/a
1144302961.50041  3168(  7) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50054  3168(  7) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50066  3168(  7) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50000  3168( 15) threadtest.pl(   29) (eval): n/a
1144302961.50016  3168( 15) threadtest.pl(   29) (eval): n/a
1144302961.50028  3168( 15) threadtest.pl(   29) (eval): n/a
1144302961.50041  3168( 15) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50053  3168( 15) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.50065  3168( 15) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.48975  3168(  6) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.48991  3168(  6) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
1144302961.49124  3168( 14) threadtest.pl(   19) Win32::Console::Write
+Char: n/a
[download]

The 'n/a' is meant to be the subroutine args, but I haven't worked out how to obtain those yet.

You invoke the clients in the usual debugger fashion:

tperl -d:Ttrace threadtest.pl
[download]

This is the debug client module(crude):

package Devel::Ttrace;
use strict;
use warnings;
use Time::HiRes qw[ time ];
require IO::Socket::INET;
require threads;

my $socket = IO::Socket::INET->new( 'localhost:54321' );

sub DB::DB {
    no warnings 'uninitialized';
    my @caller = caller(1);
    printf $socket "%15.5f %5d(%3d) %s(%5s) %s: %s\n",
        time(),
        $$,
        threads->tid,
        @caller[ 1, 2, 3 ],
        'n/a'
    ;
}

1;
[download]

I ran the server, monitor.pl in another console session and just dumped the output from the cetral queue to the screen to produce the above output. You cold modify the Worker thread to

#!perl -slw
use strict;
use threads;
use Thread::Queue;
use Smart::Comments::Lite '0';

sub worker {
    require IO::Socket::INET;
    my $tid = threads->tid;
    our $running:shared;
    our $busy:shared;
    our $die:shared;
    my( $Qwork, $Qtrace ) = @_;

    ++$running;
    while( my $fno = $Qwork->dequeue() ) {
        ##1 warn "$tid($fno): Client waiting on $fno\n";
        my $client = IO::Socket::INET->new;
        $client->fdopen( $fno, '+>' )
            or die "$tid: Failed to reopen fileno: $fno";
        ##2 warn "$tid($fno): reopened $client\n";
        ++$busy;

        ##2 warn "$tid($fno): Reading from client\n";
        while( my $data = <$client> ) {
            chomp $data;
            ##2 warn "$tid($fno): Got '$data'\n";
            $Qtrace->enqueue( $data );
        }
        ##2 warn  "$tid($fno): Client disconnected\n";
        close $client;
        shutdown( $client, 2 );
        --$busy;
    }
    --$running;
}

our $START ||= 2;
our $MAX   ||= 2000;
our $running:shared = 0;
our $busy:shared    = 0;
our $die:shared     = 0;
our $connects:shared=0;

## Use ctrl-break to terminate the server.
local $SIG{INT} = sub{
    warn "SIGINT(2) terminating";
    $die = 1;
};

my $Qwork  = new Thread::Queue;
my $Qtrace = new Thread::Queue;
our %clients;

my @threads = map{
    threads->create( \&worker, $Qwork, $Qtrace )
        or warn( "Create thread $_ failed with $^E\n" ), ();
} 1 .. $START;
## This creates new threads if the current pool is running low
async{
    until( $die ) {
        if( ( $busy + 2 ) == $running and $running < $MAX ) {
            push @threads, threads->create( \&worker, $Qwork, $Qtrace 
+)
                or warn( "Create thread $_ failed with $^E\n" ), ();
        }
        sleep 1;
    }
};

## This reads and dumps the trace information to the screen.
async{
    until( $die ) {
        print $Qtrace->dequeue();
    }
}

require IO::Socket::INET;
my $server = IO::Socket::INET->new(
    LocalPort => 54321,
    Listen   => 1000,
    Reuse    => 1.
) or die $!, $^E;

## Currently, the client sockets are not cleaned up and will eventuall
+y run out of resource.
## Fixes welcome :)
my $fno;
while( not $die and ( my $client = $server->accept ) > 0 ) {
    ++$connects;
    $clients{ $client->fileno } = $client;
    $Qwork->enqueue( $client->fileno );
}
warn "\a*** Accept failed ***\a\n" and $die = 1;
close $server;

$Qwork->enqueue( undef ) for 1 .. $running;
sleep 1 while $running;
$_->join for @threads;
[download]

Smart::Comments::Lite is my doctored version of the theDamian's CPAN tool. Comment out the use line and it will disable it completely.

This was hacked together from bits of existing code in about one hour. It imposes very little load on the programs being traced and produced sequenced information that ought to make working out where your application is disappearing up it own navel fairly easy. Redirecting the output to a file, (via tee might be good), would allow you to get a permanent record of the sequence and timing of events that lead up to the problem.

HTH.

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

In reply to Re: Win32::MMF + threads misbehavior by BrowserUk
in thread Win32::MMF + threads misbehavior by renodino

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.