#!/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;
}
[download]