A few questions:

1. You say above that Old threads remains connected to the server and I need to get rid of them!

   Do you mean: old threads within the server persist (continue to run)? For a while? Forever? Or

   Do you mean old connections persist? For a while? Forever?

   Either way, how long have you waited to see if they (whichever) will clean themselves up?

2. Does your current code work? Ie:
3. Do your commands get sent to the gprs devices?
4. Does that happen immediately, or with some delay?
5. From a previous thread, I recall that these gprs devices regularly send data (GPS coordinates?) to the server. What frequency does that happen?

This code should be essentially similar to your existing code (and may even display the same problems; though I'm hoping not).

Give it a try and let me know how you get on. (Error handling is perfunctory!).

#! perl -slw
use strict;
use IO::Socket;
use threads;
use threads::shared;

$|++;
print "$$ Server started\n";

my %devices :shared;

my $server = new IO::Socket::INET(
    Timeout   => 500,
    Proto     => "tcp",
    LocalPort => 7777,
    Reuse     => 1,
    Listen    => 5
);

while( my $client = $server->accept ) {
    next unless defined $client;

    my $peerhost = $client->peerhost;

    read $client, my $packet, 8
        or warn "Couldn't read sync packet: $!"
        and close $client and next;

    ## No use for syncHeader or syncID so discard them
    my $unitId = unpack 'x[vv]V', $packet;

    ## start the appropriate type of client thread
    threads->create(
        $peerhost == '127.0.0.1' ?  \&cmdClient : \&gprsClient,
        $unitId == 437918234 ? \&cmdClient : \&gprsClient,
        $client, $unitId
    )->detach;
}

sub cmdClient {
    my( $client, $unitId ) = @_;

    my $fileno = fileno $client;
        warn "Command Client running on $fileno\n";

    while( <$client> ) {
        my( $unitId, $cmd ) = split ':';
        warn "Got command '$cmd' for [$unitId]\n";

        ## Get the fileno for the required unitId
        my $gprsFno = do{
             lock %devices;
             unless( exists $devices{ $unitId } 
                and defined $devices{ $unitId } 
             ) {
                 warn "No device with unitId '$unitId' currently conne
+cted" 
                 and next
             };
             $devices{ $unitId }
        };

        ## dup it for output (NOTE: '>&' NOT '>=&')
        open my $fh, '>&' . $gprsFno
            or warn "Failed to dup( $gprsFno ) [$unitId]: $!"
            and next;

        ## Send the command (Won't happen (on my system) 
        ## until that unit sends us something!!!)
        print $fh $cmd
            or warn "Failed to write command '$cmd' to [$unitId]"
            and close $fh and next;

        warn "Sent '$cmd' to [$unitId]";
        close $fh;
    }
    close $client;
    warn "cmdClient [$unitId] disconnected\n";
}

sub gprsClient {
    my( $client, $unitId ) = @_;

    my $fileno = fileno $client;

    ## Add device to shared lookup table indexed by $unitId
    { lock %devices; $devices{ $unitId } = $fileno; }
    warn "gprsClient [$unitId] running on $fileno\n";

    ## Simply echo all input from the gprs device
    print "$unitId: Command response: $_" while <$client>;

    ## When the connection terminates, remove it from the lookup
    lock %devices; delete $devices{ $unitId };
    close $client;
    warn "gprsClient [$unitId] disconnected\n";
}
[download]

Hello BrowserUk,

Really thanks for your help!

I'm getting this error with your code: thread failed to start: Not a GLOB reference at tcpserver4.pl line 43 (and 83).

Old threads within the server persists for at least 10 hours
I've checked with netstat -apn | grep 8000
After tcp server is restarted they disappear

My code except this, works as it should and it immediately sends the command to the Selected client without delay.
I do include with client command data also the UnitID to whom it must send the command.
Gprs device sends gps data at minimum 10 second interval and sends sync data at a definable interval (currently at about 5 minutes)

Regards, Igor

Not a GLOB reference at tcpserver4.pl line 43 (and 83).

Would you try the following changes:

use threads qw[ yield ]; ## Why (*&^^%) isn't that exported by default
+?
...
    threads->create(
       ...
    );
    yield; sleep 1;      ## insert
}
...
[download]

1. "Old threads within the server persists for at least 10 hours"

   I just don't see that effect here. No matter how I break the connection--from quitting the client cleanly to killing the client process--the while( <$client> ) loop in the server terminates immediately, and so the thread ends.

   This seems to be one of those infamous platform differences. On windows, there are timeouts for inter-character receipt, a per-byte-to-read timeout, and a total read timeout.

   Looking at the man page for SetSockOpt(), you could try using SO_RCVTIMEO to set a maximum read timeout and see if that allowed the read to terminate.

2. " it immediately sends the command to the Selected client without delay."

   Hm. It implies that on your platform, writing to a (dup of) a socket, whilst another thread is in a read state on it, goes ahead immediately.

   That doesn't work on here. (At least for sockets as provided by IO::Socket::INET--it seem to work okay from C.)

3. "I do include with client command data also the UnitID to whom it must send the command."

   I've been doing that too. My code (when it works:(), routes the commands using the UnitID input from the command client.

---

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.

"Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."