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]