in reply to TCP Server hangs with multiple client connections

You don't mention it explicitly, but if you are using Thread::Pool, that is responsible for half your problems. The last time I tested that module it was badly broken and very, very slow. A quick look now and not much seems to have changed.

The other half is that you are trying to use non-blocking sockets on Windows via:

Blocking => 0);

Which unless the powers-that-be have finally gotten around to fixing it, doesn't work on windows.

Also, mixing select processing with multi-threading -- in the way you have done it -- is fraught with problems. It can be done (correctly), but is actually rarely needed.

It is hard to assess your program given that you supply bits rather than the whole thing; and omit significant details -- like the modules you are using -- but you seem to be doing things in very complicated ways.

For reference, here is a simple -- but substantially complete -- pool-based, multi-threaded echo server, that runs very well under extreme load on my Vista machine without skipping a beat:

#! perl -slw use strict; use threads; use threads::shared; use Thread::Queue; use IO::Socket; my $semSTDOUT :shared; sub tprint{ lock $semSTDOUT; print @_; } $|++; my %cache; my $Qwork = new Thread::Queue; my $Qdone = new Thread::Queue; my $done :shared = 0; sub worker { my $tid = threads->tid; while( my $fno = $Qwork->dequeue ) { open my $client, "+<&", $fno or die $!; tprint "$tid: Duped $fno to $client"; my $buffer = ''; while( my $c = sysread( $client, $buffer, 1, length $buffer ) +) { syswrite( $client, $buffer, 1, length( $buffer ) -1 ); while( $buffer =~ s[(^[^\n]+)\n][]g ) { tprint "$tid: got and echoed $1"; } last if $done; } close $client; $Qdone->enqueue( $fno ); tprint "$tid: $client closed"; } } our $W //= 4; my $lsn = new IO::Socket::INET( Listen => 5, LocalPort => '12345' ) or die "Failed to open listening port: $!\n"; my @workers = map threads->create( \&worker, \%cache ), 1 .. $W; $SIG{ INT } = sub { close $lsn; $done = 1; $Qwork->enqueue( (undef) x $W ); }; while( my $client = $lsn->accept ) { my $fno = fileno $client; $cache{ $fno } = $client; $Qwork->enqueue( $fno ); delete $cache{ $Qdone->dequeue } while $Qdone->pending; } tprint "Listener closed"; $_->join for @workers; tprint "Workers done";

If you want some real help with your code -- rather than getting fobbed off with "Use this module I just found on cpan and switch to flavour-du-jour of *nix." -- you'll need to let me see your complete program (here or off-forum).


With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
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.

The start of some sanity?