#! 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 connected" 
                 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";
}