Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??


You can certainly track open connections as hippo mentions. But since as choroba mentions, it's possible for the connection to close at any time without notifying you, so at best it's an optimistic estimate.

With respect to the code you've shown, I can see the confusion: When I run it, the thread reports "clients-> 5" when I connect to it a single time. I found that changing the statement reporting the number of clients from:

print "clients-> @clients\n";

to the following, it reports the correct number of clients:

print "clients->", scalar(@clients), "\n";

I've whacked on your code a little to:

  • Add a bit more information about each client to the @clients array. Please note that this requires a little bit of work in the sharing operation!
  • Don't echo a message to the person who sent it.
  • Tell each client who sent the message.

I thought about doing other stuff, like:

  • Add a SIGALRM handler so the main server can show current count of clients.
  • Announce when new clients connect.
  • Announce when we detect that clients have disconnected.
  • Show the chat dialog on the main server window for logging.

But I refrained, as I have other stuff to do and mostly to not deprive you of the fun of doing it yourself.

#!/usr/bin/perl #server use warnings; use strict; use IO::Socket; use threads; use threads::shared; $|++; print "$$ Server started\n";; # do a "top -p -H $$" to monitor server + threads our @clients : shared; @clients = (); my $server = new IO::Socket::INET( Timeout => 7200, Proto => "tcp", LocalPort => 9000, Reuse => 1, Listen => 3 ); my $num_of_client = -1; while (1) { my $client; do { $client = $server->accept; } until ( defined($client) ); my $peerhost = $client->peerhost(); print "accepted a client $client, $peerhost, id = ", ++$num_of_cli +ent, "\n"; my $fileno = fileno $client; # Build a hash of information about the client connection and # share it (deep copy) in @clients. Set it up *before* starting # the thread so it can access the data. my $hr = { ID=>$num_of_client, FILE=>$fileno, IP=>$peerhost }; push @clients, shared_clone($hr); #spawn a thread here for each client my $thr = threads->new( \&processit, $client, $fileno, $peerhost ) +->detach(); } # end of main thread sub processit { my ($lclient,$lfileno,$lpeer) = @_; #local client # Current client record my @tmp = grep { $_->{FILE} == $lfileno } @clients; my $ID = "UNKNOWN"; $ID = $tmp[0]{ID} if @tmp; if ($lclient->connected) { # Here you can do your stuff # I use have the server talk to the client # via print $client and while(<$lclient>) print $lclient "$lpeer (ID:$ID)->Welcome to server\n"; while (<$lclient>) { # print $lclient "$lpeer->$_\n"; print "clients->", scalar(@clients), ".\n"; foreach my $hr (@clients) { next if $hr->{ID} eq $ID; my $fn = $hr->{FILE}; open my $fh, ">&=$fn" or warn $! and die; print $fh "$ID says: $_"; } } } #close filehandle before detached thread dies out close( $lclient); #remove multi-echo-clients from echo list @clients = grep {$_->{FILE} !~ $lfileno} @clients; }


When your only tool is a hammer, all problems look like your thumb.

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2022-09-27 10:46 GMT
Find Nodes?
    Voting Booth?
    I prefer my indexes to start at:

    Results (119 votes). Check out past polls.