#!/usr/bin/perl -w
# ---------------------------
# Syntax:   berlindummyserver.pl [server [port]]
# ---------------------------
# 16 May 2010
#
# Note that Perl comments are preceded by a hash (#)

require 5.002; # Require this version of Perl.
use strict; # Enable strict syntax checking.
use Socket; # Use the Socket module for TCP/IP communications.
use IO::Handle; # IO::Handle provides the autoflush command.
use IO::Socket::INET;

my $numinputs = 16;
my $numoutputs = 8;
my (@inputstate, @outputstate);
for (my $i = 0; $i < $numinputs; ++$i) {
    $inputstate[$i] = 0;
}
for (my $i = 0; $i < $numoutputs; ++$i) {
    $outputstate[$i] = 0;
}
# Special
$inputstate[2]=1;
$inputstate[5]=1;
$outputstate[2]=1;

my $port = shift || 5002; # Get (main) port number or supply default (default as per York Winter's email of 17/5/10).
my ($client, $command, $reply, $channel, $duration, $state, $hostinfo); # Declare other variables.
my $DEBUGNETWORK = 1; # Controls verbose printing of network communications
my $delimiter = "\n\r"; # CR (\n), LF (\r)

print "Berlin dummy server in Perl\n";
print "---------------------------\n";
print "Starting on port $port\n";

# Open network connection.
# http://www.osix.net/modules/article/?id=101
# Listen = number of pending connections; SOMAXCON is a special symbol for the system maximum
# Reuse = restart the server manually 
my $server = IO::Socket::INET->new( Proto => 'tcp', LocalPort => $port, Listen => SOMAXCONN, Reuse => 1); 
die "can't setup server" unless $server;
print "[Server $0 is running]\n";

# Now wait for a connection. (Can telnet to this server as a test.) 
while ($client = $server->accept()) {
    $client->autoflush(1);
    my ($name, $aliases, $addrtype, $length, @addrs);
    ($name, $aliases, $addrtype, $length, @addrs) = gethostbyaddr($client->peeraddr, AF_INET);
    printf "[Connect from %s]\n", $name;
 
    # Enter a loop to listen to messages from the server.
    while ($command = <$client>) {
        $command =~ s/\s+$//; # remove trailing rubbish
        $command =~ s/^\s+//; # remove leading rubbish
        # don't use chomp (which only removes \n); instead, remove CR, LF, any other trailing whitespace
        # http://www.wellho.net/forum/Perl-Programming/New-line-characters-beware.html
        if ($DEBUGNETWORK) {
            print "CLIENT: $command\n"; # For info only.
            # print "String length = " . length($command) . "\n";
        }
        if ($command =~ /^GetNumberOfInputChannels/) {
            Send("NumberOfInputChannels 16");
        } 
        if ($command =~ /^GetNumberOfOutputChannels/) {
            Send("NumberOfOutputChannels 8");
        } 
        if ($command =~ /^SetChannelOn (.+)/) {
            $channel = $1;
            if ($channel >= 0 && $channel < $numinputs) {
                $outputstate[$channel] = 1;
                print "Output channel " . $channel . " set ON\n";
            }
            # Now a silly debug bit
            if ($channel == 5 || $channel == 6) {
                $inputstate[4] = !$inputstate[4];
                Send("SensorState 4 " . $inputstate[4]);
            }
            # No response
        }
        if ($command =~ /^SetChannelOnPulse (.+) (.+)/) {
            $channel = $1;
            $duration = $2;
            if ($channel >= 0 && $channel < $numinputs) {
                $outputstate[$channel] = 1;
                print "Output channel " . $channel . " set ON for pulse of " . $duration . " (NOT REALLY IMPLEMENTED)\n";
                # should set it off later, but never mind ***
            }
            # No response
        }
        if ($command =~ /^SetChannelOff (.+)/) {
            $channel = $1;
            if ($channel >= 0 && $channel < $numinputs) {
                $outputstate[$channel] = 0;
                print "Output channel " . $channel . " set OFF\n";
            }
            # No response
        }
        if ($command =~ /^GetSensorState (.+)/) {
            $channel = $1;
            if ($channel >= 0 && $channel < $numinputs) {
                Send("SensorState " . $channel . " " . $inputstate[$channel]);
            }
        }
        # Can also send SensorState messages spontaneously ***  
    }
    close ($client) || die "Error closing socket: $!";
    print "[Disconnected.]\n";
}
# use CTRL-C to shut down the server
exit;

sub Send {
    # Send something to the server on the main socket, with a trailing newline.
    if ($DEBUGNETWORK) { print STDOUT "Message to client: @_\n"; } # For info only.
    print $client "@_" . $delimiter;
}

# -----------------------------------------------------------
# --------------------------- User interface routines.
# -----------------------------------------------------------

sub AskUser {
    print "$_[0] [$_[1]]: ";
    my $rc = <>;
    chomp $rc;
    if($rc eq "") { $rc = $_[1]; }
    return $rc;
}
