#!/usr/bin/perl

use strict;
use warnings;

###############################################################################
# Here's an overview of all the processes involved:
#
# slinked main process: This listens on the TCP socket.  When it gets
# a connection, it receives commands from it and process them.
# Processing may involve sending a command message to the Slink-e
# device.  When it does this, it usually then listens to the command
# response IPC message queue for the response to that command.
#
# Slinke::Receiver process: This is part of the Slinke::Control object.  It
# listens for messages from the Slink-e device.  It splits them into command
# responses and unsolicited messages, routing them respectively to the 
# command response IPC message queue and the unsolicited message IPC message
# queue.
#
# slinked receiver process:  This listens on the unsolicited message
# queue.  It analyzes each message and routes it to one of various IPC
# message queues based on its content.  These are called notify queues.
#
# Message processor process: This is a process, which you start independently
# of Slinked, that listens to one of the notify queues.  There could be many
# of these processes - one for each notify queue.
###############################################################################

use Slinke::Irdb;
use Slinke::Control;
use Slinke::Ircode;
use Data::Dumper;
use English;
use Errno qw(:POSIX EIDRM);
use POSIX qw(strftime);
use Time::HiRes qw(tv_interval gettimeofday);
use Getopt::Long;
use IO::Socket::INET;

my $TRUE=1; my $FALSE = 0;

my $DEFAULT_TIMEOUT = 50000;      # In microseconds

my $IPCTYPE_SLINKE = 1;

my %msgHistory;
    # %msgHistory is defined as follows:
    #
    # $msgHistory{$zone} is the history of messages received in Zone
    # number $zone via this package.  It is a reference to a hash with
    # these keys:
    #
    #   TIME     => Date/time a message was most recently received.  This is a
    #               reference to a list of (seconds, microseconds), as
    #               used by with the Time::HiRes package.
    #
    #   COMPNAME => Component name of component of the message referred to 
    #               above.
    #   COMMANDNAME =>
    #               Command name of the message referred to above.
    #
    # A "continue" message counts as a duplicate of the original command;
    # i.e. it updates TIME, but leaves COMPNAME and COMMAND alone.
    #  
    # $msgHistory{$zone} is undefined if no message has ever been received in
    # zone $zone.


sub max($$) { return $_[0] > $_[1] ? $_[0] : $_[1]; }
sub min($$) { return $_[0] < $_[1] ? $_[0] : $_[1]; }


my $debugLevel;

sub debug($$) {
    my ($level, $message) = @_;
    if ($debugLevel >= $level) {
        print("$message\n");
    }
}



sub logmsg($) {

    my ($msg) = @_;

    my $timestamp = strftime("%y.%m.%d %H:%M:%S", gmtime(time()));

    print("$timestamp $msg\n");
}



sub signalHandler {
    my ($signal) = @_;

    # This signal handler is the same as letting Linux just terminate the
    # process (which is what it would do if no signal handler), except that
    # it allows our object destructors to run.

    die("Terminating due to signal $signal received");
}



sub recordHistory($$$) {
    my ($zoneHistoryR, $compName, $commandName) = @_;
    
    my $zoneHistory;

    if (defined($$zoneHistoryR)) {
        $zoneHistory = $$zoneHistoryR;
    } else {
        $zoneHistory = \my %zoneHistory;
        $$zoneHistoryR = $zoneHistory;
    }
    $zoneHistory->{COMPNAME}    = $compName;
    $zoneHistory->{COMMANDNAME} = $commandName;
    $zoneHistory->{TIME}        = [gettimeofday()];
}



sub accessDatabase($$$) {
    my ($file, $debugLevel, $databaseR) = @_;

    Slinke::Irdb->createObject(FILE     => $file, 
                               DEBUG    => max($debugLevel, 1) - 1,
                               DATABASE => \my $database, 
                               STATUS   => \my $dbStatus, 
                               ERROR    => \my $error,
                               );

    if ($error) {
        die("Failed to create database.  $error");
    }

    if ($dbStatus->{NEWFILE}) {
        die("No file named '$dbStatus->{FILENAME}' found.  ");
    } else {
        print("Read $dbStatus->{COMPONENT_COUNT} components, " .
              "$dbStatus->{COMMAND_COUNT} commands.\n");
    }
    $$databaseR = $database;
}



sub reportSlinkeInfo($$) {
    my ($slinke, $errorR) = @_;

    $slinke->getVersion(VERSION => \my $slinkeVersion,
                        ERROR   => \my $error);
    
    if ($error) {
        $$errorR = "Unable to get Slink-e version from Slink-e.  $error";
    } else {
        print("Slink-e reports its version as $slinkeVersion\n");
        
        $slinke->getSerialNumber(SERIALNO => \my $slinkeSerialNumber,
                                 ERROR    => \my $error);
        if ($error) {
            $$errorR = "Unable to get serial number from Slink-e.  $error";
        } else {
            print("Slink-e reports its serial number as " .
                  "$slinkeSerialNumber\n");
            print("\n");
        }
    }
}



sub accessSlinke($$$$$$$) {
    my ($deviceFileName, $receiveMask,
        $debugLevel, $irsampleperiod, $irtimeout, $messagerR, $errorR) =
        @_;
#-----------------------------------------------------------------------------
#  Create and return a Slinke::Control object for the Slink-e.
#
#  Initialize the device and print information about it to Standard Output.
#
#  Die if we encounter any problems.
#-----------------------------------------------------------------------------
    if (!defined($deviceFileName)) {
        $$errorR = "Device name argument to accessSlinke() undefined";
    } else {
        my $slinkeDebugLevel = max(0, $debugLevel - 1);

        Slinke::Control->createObject(SLINKE => \my $slinke,
                                      DEVICE => $deviceFileName, 
                                      DEBUG  => $slinkeDebugLevel,
                                      ERROR  => \my $error,
                                      );
        
        if ($error) {
            $$errorR = "Slinke::Control unable to access Slink-e " .
                "on $deviceFileName.  " .
                "Slinke::Control->createObject() failed.  $error";
        } else {
            print("Communication established with Slink-e.\n");

            reportSlinkeInfo($slinke, $errorR);

            if (!$$errorR) {
                Slinke::Messager->createObject
                    (
                     SLINKE         => $slinke,
                     DEBUGLEVEL     => $debugLevel,
                     IRSAMPLEPERIOD => $irsampleperiod,
                     IRTIMEOUT      => $irtimeout,
                     MESSAGER       => \my $messager,
                     ERROR          => \my $error,
                     );
                if ($error) {
                    $$errorR = "Unable to create " .
                        "Slinke::Messager object.  $error";
                } else {
                    $$messagerR = $messager;
                }
            }
        }
    }
}



sub parseNotifyLine($$$$) {
    my ($component, $attributes, $notifyR, $errorR) = @_;

    my $notify;
    my $errorRet;

    my @tokens = split(m{\s+}, $attributes);
    for (my $i = 0; $i < @tokens && !$errorRet; ++$i) {
        if ($tokens[$i] =~ m{ ^ (\S+) = (\S+) $ }x) {
            my ($keyword, $value) = ($1, $2);
            $notify->{$keyword} = $value;
        } else {
            $errorRet = "Token '$tokens[$i]' for component '$component' " . 
                "does not have format keyword=value";
        }
    }
    if (!$errorRet) {
        if (!$notify->{HOST}) {
            $errorRet = "No HOST attribute for component '$component'";
        } elsif (!$notify->{PORT}) {
            $errorRet = "No PORT attribute for component '$component'";
        } elsif ($notify->{PORT} !~ m{\d+}) {
            $errorRet = "Port '$notify->s{PORT}' is not a " . 
                "decimal whole number";
        }
    }
    $$errorR  = $errorRet;
    $$notifyR = $notify;
}



sub readNotifies($$$) {

    my ($notifyFileName, $notifiesR, $errorR) = @_;

    my %notifies;

    my $errorRet;

    open(NOTIFYFILE, '<', $notifyFileName) or
        $errorRet = "Unable to open notify file '$notifyFileName'.  " .
            "errno = $ERRNO";

    while (defined(my $line = <NOTIFYFILE>) && !$errorRet) {
        if ($line =~ m{ ^ \s* $ }x ) {
            # It's a blank line
        } elsif (substr($line, 0, 1) eq '#') {
            # It's a comment.
        } elsif ($line =~ m{ \s* (\S+) \s* (.*) $ }x) {
            my ($component, $attributes) = ($1, $2);

            if ($notifies{$component}) {
                $errorRet = "Duplicate component: $component";
            } else {
                parseNotifyLine($component, $attributes, 
                                \$notifies{$component}, \my $error);
                if ($error) {
                    $errorRet = "Invalid line in Notify file " .
                        "'$notifyFileName'.  $error";
                }
            }
        } else {
            $errorRet = "Line '$line' does not start with a component name";
        }
    }
        
    close(NOTIFYFILE);
    
#    print STDERR Data::Dumper->Dump([ \%notifies, "notifies" ]);

    $$notifiesR = \%notifies;
    $$errorR = $errorRet;
}



sub setupNotifies($$$) {

    my ($notifyFileName, $notifiesR, $errorR) = @_;

    my $errorRet;

    readNotifies($notifyFileName, \my $notifies, \my $error);
    if ($error) {
        $errorRet = "Unable to process Notify file.  $error";
    } else {
        my @compList = keys(%{$notifies});
        for (my $i = 0; $i < @compList && !$errorRet; ++$i) {
            my $compName = $compList[$i];
            my $notify = $notifies->{$compName};
            
            my $socket = IO::Socket::INET->new(Proto    => "udp",
                                               PeerHost => $notify->{HOST},
                                               PeerPort => $notify->{PORT}
                                               );
            
            if (!defined($socket)) {
                $errorRet = "Unable to create UDP socket to talk to Host " .
                    "'$notify->{HOST}', Port $notify->{PORT}";
            } else {
                $notify->{SOCKET} = $socket;
            }
        }
    }
    $$notifiesR = $notifies;
    $$errorR = $errorRet;
}



sub receiveCommand($) {
    my ($commandSource) = @_;
#-----------------------------------------------------------------------------
#  Receive a command from the buffered source $commandSource.  That means
#  get the next command from the buffer, and if there is no complete command
#  in the buffer, first read the socket until there is.
#-----------------------------------------------------------------------------
    my $message;

    my $eof;

    $eof = $FALSE;

    while (!$message && !$eof) {
        if ($commandSource->{buffer} =~ m{ (.*?) \s* \n (.*) $ }x) {
            # There's a newline in the buffer.  Everything up to the newline
            # is the next command in the buffer.  Extract and return it.
            $message = $1;
            $commandSource->{buffer} = $2;
        } else {
            # Buffer's dry.  Go to the socket for more.

            recv($commandSource->{socket}, my $chunk, 80, 0);
            
            debug(5, "Received characters 0x" . unpack("H*", $chunk) . 
                  " from socket");

            if ($chunk eq "") {
                $eof = $TRUE;
            } else {
                $commandSource->{buffer} .= $chunk;
            }
        }
    }
    if (defined($message)) {
        debug(4, "Command source producing message '$message'");
    } else {
        debug(4, "EOF on command source");
    }
    return $message;
}



sub newCommandSource($) {
    my ($socket) = @_;

    my %commandSource;

    $commandSource{buffer} = "";  # start with empty buffer
    $commandSource{socket} = $socket;

    bless(\%commandSource);

    return \%commandSource;
}



sub ignoreSignalHandler {
}



sub playcmd($$$$) {
    my ($database, $messager, $args, $errorR) = @_;

    if ($args =~ m{ ^ \s* (\S+) \s* (\S+) \s* (\S+)? \s* $ }x) {
        my ($compName, $commandName, $count) = ($1, $2, $3);
        
        $database->sendIrMessage(SLINKEMSGR   => $messager, 
                                 COMPONENT    => $compName, 
                                 COMMAND      => $commandName,
                                 COUNT        => $count,
                                 WANTFEEDBACK => $FALSE,
                                 ERROR        => $errorR,
                                 );
    } else {
        $$errorR = "Invalid playcmd syntax:  Need at least two arguments: " .
            "component, command";
    }
}



sub reset($$$$) {
    my ($database, $messager, $args, $errorR) = @_;

    if ($args =~ m{\S}) {
        $errorR = "Invalid reset syntax:  no arguments allowed";
    } else {
        $messager->refresh(ERROR => $errorR);
    }
}



sub executeCommand($$$$) {
    my ($command, $messager, $database, $replySocket) = @_;

    my $error;

    logmsg("Executing command '$command'");

    # Make process not get killed if we write into a closed socket:
    local $SIG{"PIPE"} = \&ignoreSignalHandler;

    if ($command =~ m{ \s* (\S+) \s* (.*) $ }x) {
        my ($verb, $args) = ($1, $2);

        if ($verb eq "log") {
            # The side effect of logging this command is all User wants.
        } elsif ($verb eq "playcmd") {
            playcmd($database, $messager, $args, \$error);
        } elsif ($verb eq "reset") {
            main::reset($database, $messager, $args, \$error);
        } else {
            $error = "command '$command' has unrecognized verb '$verb'";
        }
    } else {
        $error = "Invalid command '$command' - no verb";
    }
    my $reply;
    if ($error) {
        $reply = "ERROR $error";
    } else {
        $reply = "OK";
    }
    send($replySocket, "$reply\n", 0);
    logmsg("Reply: $reply");
}



sub commandLoop($$$) {
    
    my ($messager, $listenSocket, $database) = @_;

    my $error;

    while(!$error) {
        debug(1, "Listening for TCP connection...");

        my $connectedSocket = $listenSocket->accept();

        if (!defined($connectedSocket)) {
            $error = "accept() on socket failed.";
        } else {        
            logmsg("Accepted TCP connection from Port " .
                   $connectedSocket->peerport() . " on Host " .
                   $connectedSocket->peerhost());

            send($connectedSocket, "greetings from slinked\n", 0);

            my $commandSource = newCommandSource($connectedSocket);

            my $eof;

            $eof = $FALSE;

            while (!$eof) {
                my $command = receiveCommand($commandSource);
            
                if (!defined($command)) {
                    $eof = $TRUE;
                } else {
                    executeCommand($command, $messager, $database, 
                                   $connectedSocket);
                }
            }
            $connectedSocket->shutdown(2);
        }
    }
    print("Error: $error.\n");
}



sub repeatedCommand($$$) {
    my ($compName, $commandName, $zone) = @_;
#-----------------------------------------------------------------------------
#  Return true if command $commandName for component $compName in zone $zone
#  is a repeat of an identical message recently received.  I.e. it is merely
#  a notification that the user is still holding down the button, not a 
#  new button press.
#-----------------------------------------------------------------------------
    my $retval;

    my $zoneHistory = $msgHistory{$zone};

    if (defined($zoneHistory)) {
        if (tv_interval($zoneHistory->{TIME}) < 0.2 &&
            $zoneHistory->{COMPNAME} eq $compName &&
            $zoneHistory->{COMMANDNAME} eq $commandName) {
            
            # We received the same command less than a fifth of second ago,
            # So this must be a continuation repetition.

            $retval = $TRUE;
        } else {
            $retval = $FALSE;
        }
    } else {
        $retval = $FALSE;
    }
}



sub processReceivedCommand($$$$$$) {
    my ($zone, $componentCode, $commandCode, 
        $database, $notifies, $errorR) = @_;
    
    my $compName = $database->compNameFromCode($componentCode);

    if (!defined($compName)) {
        $$errorR = "Unrecognized component code";
    } else {
        $database->lookupCommandCode($compName, $commandCode,
                                     \my $commandName, \my $error);
        
        if ($error) {
            $$errorR = "Invalid command code for component '$compName'.  " .  
                "$error";
        } else {
            if (!defined($commandName)) {
                $$errorR = "Unrecognized command code";
            } else {
                logmsg("Received command '$commandName' " .
                       "for component '$compName'");
                my $notify = $notifies->{$compName};
                if (defined($notify)) {
                    if (!$notify->{CONTINUE} && 
                        repeatedCommand($compName, $commandName, $zone)) {
                        # This is a repeated command that just says the user
                        # is still holding down the button.  Client does not
                        # want to hear about that.  We discard this msg.
                        debug(1, "Discarding continuation message");
                    } else {
                        debug(1, "Delivering to UDP socket " .
                              "$notify->{HOST}:$notify->{PORT}");
                        my $msg = "COMMAND $commandName";
                        my $bytesSent = $notify->{SOCKET}->send($msg);
                        if (!$bytesSent) {
                            warn("Failed to send $commandName command.  " .
                                 "errno=$ERRNO");
                        }
                    }
                }
                recordHistory(\$msgHistory{$zone}, $compName, $commandName);
            }
        }
    }
}



sub processReceivedContinuation($$$) {
    my ($zone, $notifies, $errorR) = @_;

    debug(2, "Received continuation IR message");

    my $compName    = $msgHistory{$zone}->{COMPNAME};
    my $commandName = $msgHistory{$zone}->{COMPNAME};

    my $notify = $notifies->{$compName};

    if (defined($notify)) {
        if (!$notify->{CONTINUE}) {
            debug(2, "Discarding continuation message");
        } else {
            debug(1, "Delivering to UDP socket " .
                  "$notify->{HOST}:$notify->{PORT}");
            
            my $msg = "CONTINUE";
            my $bytesSent = $notify->{SOCKET}->send($msg);
            if (!$bytesSent) {
                warn("Failed to send CONTINUE notification.  " .
                     "errno=$ERRNO");
            }
        }
        recordHistory(\$msgHistory{$zone}, $compName, $commandName);
    }
}

                           

sub isContinuation($$$) {

    my ($database, $pulseSet, $zone) = @_;

    if (!$database) {
        die("Must pass database object handle to isContinuation()");
    }

    my $retval;

    my $zoneHistory = $msgHistory{$zone};
    if ($zoneHistory) {
        $retval = $database->isContinuationMessage
            (
             PULSESET      => $pulseSet,
             ELAPSEDTIME   => tv_interval($zoneHistory->{TIME}),
             LASTCOMPONENT => $zoneHistory->{COMPNAME}
             );
        debug(4, "Slinke::Irdb::isContinuationMessage says " . ($retval||0));
    } else {
        $retval = $FALSE;
    }
    return $retval;
}



sub decodeIrMessage($$$$) {
    my ($message, $database, $irMessageR, $errorR) = @_;

    if (isContinuation($database, $message->{CONTENTS}, $message->{ZONE})) {
        my %irMessage;
        $irMessage{CONTINUE} = $TRUE;
        $$irMessageR = \%irMessage;
        $$errorR = undef;
    } else {
        Slinke::Ircode::decodeIrMessage($message->{CONTENTS}, 
                                        $irMessageR, $errorR);
    }
}



sub processReceivedMessage($$$$) {
    my ($message, $database, $notifies, $errorR) = @_;

    if ($message->{TYPE} eq "CONTROL") {
        print("Unexpected $message->{REPORTTYPE} message " .
              "from port $message->{PORT}.  " .
              "data='$message->{DATA}'.  Ignoring.\n");
    } elsif ($message->{TYPE} eq "PORTMSG" &&
             $message->{PORT} eq "PORT_IR") {
        debug(3, "Got an IR message");
        
        decodeIrMessage($message, $database, \my $irMessage, \my $error);

        if ($error) {
            $$errorR = "Unable to decode the received message.  $error.";
        } else {
            if ($irMessage->{CONTINUE}) {
                processReceivedContinuation($message->{ZONE}, $notifies,
                                            $errorR);
            } elsif (defined($irMessage->{CODE})) {
                if (!defined($irMessage->{COMPONENT_CODE}) ||
                    !defined($irMessage->{COMMAND_CODE})) {
                    $$errorR = "Unable to find the component code and " .
                        "command code in the IR code $irMessage->{CODE}";
                } 
                processReceivedCommand($message->{ZONE}, 
                                       $irMessage->{COMPONENT_CODE},
                                       $irMessage->{COMMAND_CODE},
                                       $database, $notifies, $errorR);
            } else {
                $$errorR = "INTERNAL ERROR: decodeIrMessage succeeded, " .
                    "but did not return either an IR code or continuation";
            }
        } 
    }
}



sub receiver($$$) {
    my ($messager, $database, $initialNotifies) = @_;

    my $receiveError;
    my $notifies;

    $receiveError = $FALSE;

    $notifies = $initialNotifies;

    while(!$receiveError) {
        # TODO: Put something here to capture SIGHUP and 
        # run setupNotifies() again to replace $notifies.
        debug(2, "Waiting for message from Slink-e");
        $messager->receiveSlinkeMessage(MESSAGE => \my $message,
                                        ERROR   => \my $error);
        if ($error) {
            warn("Slinke::Messager::receiveSlinkeMessage() failed.  $error");
            $receiveError = $TRUE;
        } else {
#            print STDERR Data::Dumper->Dump([ \$message ], [ "message" ]);

            debug(2, "$message->{TYPE} message " .
                  "from Slink-e port $message->{PORT}");
                    
            processReceivedMessage($message, $database, $notifies, \my $error);
            if ($error) {
                logmsg("Ignoring received message.  $error");
            }
        }
    }
}



sub createReceiver($$$$) {
    my ($messager, $database, $notifyFileName, $debugLevel) = @_;

    setupNotifies($notifyFileName, \my $notifies, \my $error);

    if ($error) {
        die("Unable to set up notifications.  $error");
    }

    my $forkRc = fork();
    if (defined($forkRc)) {
        if ($forkRc == 0) {
            # We are the child -- the receiver process
            $messager->forkedCopy();
            $database->{FORKED_COPY} = $TRUE;
            receiver($messager, $database, $notifies);
            print("Receiver terminating.\n");
            exit(0);
        } else {
            # We are the parent
            debug(2, "Receiver process created.  Pid = $forkRc");
        }
    } else {
        die("Unable to create the receiver process.  " .
            "fork() failed.  errno=$ERRNO");
    }
}



#############################################################################
#  MAINLINE
#############################################################################

autoflush STDOUT 1;

my %cmdline = ();
my $validOptions = GetOptions(\%cmdline,
                              "database=s",
                              "notify=s",
                              "device=s",
                              "irsampleperiod=i",
                              "irtimeout=i",
                              "debuglevel=i",
                              );
if (!$validOptions) {
    die("Invalid syntax");
}

if (@ARGV > 0) {
    die("Program takes no arguments.  You specified " . @ARGV . ".");
}

if (!defined($cmdline{"device"})) {
    die("You must specify the -device option");
}

my $databaseFileName = ($cmdline{"database"} or "slinke.irdb");

my $notifyFileName = ($cmdline{"notify"} or "slinke.notify");

$debugLevel = ($cmdline{"debuglevel"} or $FALSE);

local $SIG{"INT"} = \&signalHandler;
local $SIG{"TERM"} = \&signalHandler;

accessDatabase($databaseFileName, $debugLevel, \my $database);

accessSlinke($cmdline{"device"}, 0xff, $debugLevel, 
             $cmdline{IRTIMEOUT}, $cmdline{IRSAMPLEPERIOD},
             \my $messager, \my $error);

if ($error) {
    die("Unable to access the Slink-e device.  $error");
}

createReceiver($messager, $database, $notifyFileName, $debugLevel);

# Set up TCP socket on which to listen for commands

my $socket = IO::Socket::INET->new(Proto     => "tcp", 
                                   Listen    => 5, 
                                   LocalAddr => "localhost",
                                   LocalPort => 8153);

if (!defined($socket)) {
    die("Failed to create TCP socket on which to listen.  errno=$ERRNO");
}

print("Socket established, entering command loop\n");

commandLoop($messager, $socket, $database);

$socket->shutdown(2);
