#!/usr/bin/perl

use strict;
use warnings;
use Slinke::Control;
use Slinke::Irdb;
use Slinke::Ircode;
use Data::Dumper;
use English;
use Errno qw(:POSIX);
use Time::HiRes qw(tv_interval gettimeofday);
use Getopt::Long;
use Term::ReadLine;
use POSIX qw(floor);

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


my $DEFAULT_SAMPLE_PERIOD = 100;  # In microseconds
my $DEFAULT_TIMEOUT = 50000;      # In microseconds

my $currentComponentName;
    # The name of the current component.  This is the component for which the
    # "learn code" function expects to get a code.

my @playZones;
    # The list of IR zones in which a 'playcmd' command
    # transmits IR messages.  It is a list of zone numbers, e.g. (0,1,5).
    # It isn't in any particular order, but it doesn't have duplicates and
    # it doesn't contain zones that don't exist on our Slink-e.

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.
    #  
    # $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]; }

sub isnumber($) {
    return $_[0] =~ m{^ [-+]? (?: \d+ \. \d* | \. \d+)? $ }x;
}
sub isinteger($) {
    return $_[0] =~ m{^ [-+]? \d+ $ }x;
}
sub iswhole($) {
    return $_[0] =~ m{^ \d+ $ }x;
}
sub isnatural($) {
    return $_[0] =~ m{(?= ^ \d+ $ ) .* [^0]}x;
}

my $activeDebugLevel;

sub debug($$) {
    my ($level, $message) = @_;

    if ($activeDebugLevel >= $level) {
        print("slinke: $message\n");
    }
}


#############################################################################
#  SET FUNCTIONS
#############################################################################

sub presentInSet($$) {
    my ($element, $setR) = @_;

    my $present;

    foreach (@{$setR}) {
        if ($element eq $_) {
            $present = $TRUE;
        }
    }
    return $present;
}

sub delFromSet($$) {
    my ($element, $setR) = @_;

    my $i;
    my $deleted;
    
    $i = 0;
    
    while ($i < @{$setR} && !$deleted) {
        if ($element eq $setR->[$i]) {
            splice(@{$setR}, $i, 1);
            $deleted = $TRUE;
        }
        ++$i;
    }
}

sub addToSet($$) {
    my ($element, $setR) = @_;

    delFromSet($element, $setR);

    push(@{$setR}, $element);
}

#############################################################################


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

    print("Reading existing database (if any) from file '$file'...\n");

    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}) {
        print("No file named '$dbStatus->{FILENAME}' found.  " .
              "Starting database from scratch.\n");
    } else {
        print("Read $dbStatus->{COMPONENT_COUNT} components, " .
              "$dbStatus->{COMMAND_COUNT} commands.\n");
    }
    $$databaseR = $database;
}



sub writeOutDatabase($) {

    my ($database) = @_;

    print("Writing updated database to '" .
          $database->dbStatus()->{FILENAME} . "'\n");

    my $error;

    $database->writeDatabase(\$error);

    if ($error) {
        print("Unable to write out database (database updates lost).  " .
              "$error");
    }
}



sub historyFileName {
    my $retval;

    if (defined($ENV{"HOME"})) {
        $retval = $ENV{"HOME"} . "/.slinke.history";
    } else {
        warn("HOME environment variable not set.  " .
             "Can't restore or save readline history.");
    }
    return $retval;
}



sub signalHandler {
    my ($signal) = @_;
    die("Signal $signal received");
}



sub receiveIrMessage($$$$) {

# This subroutine actually receives a Slink-e pulse set, not an IR
# message.  In the normal case, that pulse set contains multiple IR
# messages, because 'messager' keeps the IR Timeout Period set to longer
# than an intermessage pause.

    my ($messager, $pulseTrainR, $receiveZoneR, $errorR) = @_;
    
    my $errorRet;

    if (!$messager->isa("Slinke::Messager")) {
        $errorRet = "Slinke messager object is not a Slinke::Messager";
    } else {
        my $message;

        eval {
            local $SIG{"INT"} = \&signalHandler;
            
            my $gotAMessage;

            while (!$errorRet && !$gotAMessage) {
                debug(2, "Waiting for message from Slink-e");
                $messager->receiveSlinkeMessage(MESSAGE => \$message,
                                                ERROR   => \my $error);
#                print Data::Dumper->Dump([ \$message ], [ "message" ]);
                if ($error) {
                    $errorRet = 
                        "Failed to receive a message from Slinke.  $error";
                } else {
                    debug(2, "$message->{TYPE} message " .
                          "from Slink-e port $message->{PORT}");
                    
                    if ($message->{TYPE} eq "CONTROL") {
                        print("Unexpected $message->{REPORTTTYPE} message " .
                              "from port $message->{PORT}.  " .
                              "data=$message->{DATA}.  Ignoring.\n");
                    } elsif ($message->{TYPE} eq "PORTMSG" &&
                             $message->{PORT} eq "PORT_IR") {
                        $gotAMessage = $TRUE;
                    }
                }
            }
        };

        if ($@) {
            # The eval block terminated abnormally.
            if ($@ =~ m{^Signal INT received}) {
                # It was terminated by our signal handler; We consider
                # that a success with nothing received:
                $$pulseTrainR = undef;
            } else {
                $errorRet = "Died while trying to receive IR code.  $@";
            }
        } else {
            if (defined($pulseTrainR)) {
                $$pulseTrainR = $message->{CONTENTS};
            }
            if (defined($receiveZoneR)) {
                $$receiveZoneR = $message->{ZONE};
            }
        }
    }
    if (defined($errorR)) {
        $$errorR = $errorRet;
    }
}



sub displayCommands() {
    print( <<ENDLIST

Commands: 
  quit
  help
  save
  revert
  learncomp
  delcomp
  listcomp
  setcomp
  showcomp
  learncmd
  delcmd
  listcmd
  playcmd
  timecmd
  getirmsg
  playzone  
  ctl
ENDLIST
           );
}



sub help(@) {

    my ($cmd, $rest) = @_;

    my %help = (
                "quit" => <<ENDHELP
Exits the program.  EOF does the same thing.
ENDHELP
                ,
                "help" => <<ENDHELP
Gives help on commands.

  help <command>

With no arguments, lists all commands
ENDHELP
                , 
                "getirmsg" => <<ENDHELP
Listens for an IR pulse set from Slink-e.  When it gets one, interprets it
as an IR message and tells you what command the message contains.

  getirmsg [-showcode] [-showpulse] [-continuous] [-verbose]

    -showcode:   Include the IR code in the output
    -showpulse:  Describe all the on and off pulses in the pulse set
                 (up to, but not including the off pulse that delimits the 
                 end of the pulse set)
    -continuous: Continue ad infinitum

Use SIGINT (ctl-C) to interrupt the wait for the message
ENDHELP
                ,
                
                "playcmd" => <<ENDHELP
Transmits an IR message

  playcmd <command> [-count=N] [-verify]

The command is for the current component.

-count is the number of times to send the message, with minimal intermessage
pauses between.  Default is 1.

With -verify, listens for the message on IR receivers and confirms
that the same message sent is received.  Use ctl-C to abort.  Without
-verify, this command disables receivers while sending the command, so
you won\'t see any echo.
ENDHELP
                 ,
                "timecmd" => <<ENDHELP
Reports how much time an IR message would take.

  timecmd <command> [-count=N]

The command is for the current component.

-count is the number of times to send the message, with minimal intermessage
pauses between.  Default is 1.
ENDHELP
                 ,
                "learncmd" => <<ENDHELP
  learncmd <command>

Causes program to wait for the Slink-e to receive an IR pulse set (or
produce one it received previously and has in its buffer), then
interpret the pulse set as an IR message and enter that message into
the database as the specified command for the current component.
ENDHELP
                 ,
                "save" => <<ENDHELP
Save the current database (with modifications you have made since loading
it) to the file from which it was read.
ENDHELP
                 ,
                "revert" => <<ENDHELP
Discard all changes to the database and reload it from the same file
from which it was originally read.
ENDHELP
                 ,
                "playzone" => <<ENDHELP
Set and query the IR zones in which a 'playcmd' command will send IR
messages.  This command does not directly affect the zone mask in the
Slink-e device; it is just a mode for this program.

  playzone {enable, disable} <zone>

See also 'ctl irzone'.
ENDHELP
                 ,
                "ctl" => <<ENDHELP
Do a low-level slinke command.  Using this command may interfere with using
this program's higher level functions, which assume they are the only thing
accessing the Slink-e at this level.

  ctl <subcommand> <arguments>

To list subcommands, use 

  ctl help
ENDHELP
                ,
                   );

    if (!defined($cmd)) {
        displayCommands();
    } else {
        if (defined($help{$cmd})) {
            print($help{$cmd});
        } else {
            print("No help available for topic '$cmd'\n");
        }
    }        
    print("\n");
}



sub save($@) {
    my ($database, @args) = @_;

    if (@args > 0) {
        print("Error: there are no arguments\n");
    } else {
        writeOutDatabase($database);
    }
}



sub revert($@) {
    my ($database, @args) = @_;

    if (@args > 0) {
        print("Error: there are no arguments\n");
    } else {
        my $status;
        my $error;
        $database->readDatabase(\$status, \$error);
        
        if ($status->{NEWFILE}) {
            print("No file named '$status->{FILENAME}' found.  " .
                  "Database is now empty.\n");
        } else {
            print("read $status->{COMPONENT_COUNT} components, " .
                  "$status->{COMMAND_COUNT} commands from " .
                  "$status->{FILENAME}\n");
        }
    }
}



sub setcomp(@) {

    my ($componentName, $rest) = @_;

    if (!defined($componentName) || defined($rest)) {
        print("Wrong number of arguments.  'setcomp' takes one argument: " .
              "a component name\n");
    } else {
        $currentComponentName = $componentName;
        print("Current component is now '$currentComponentName'\n");
    }
}



sub showcomp(@) {
    
    if (@_ > 0) {
        print("'showcomp' has no arguments.  Ignoring arguments\n");
    }
    if (defined($currentComponentName)) {
        print("Current component is '$currentComponentName'\n");
    } else {
        print("The current component is undefined.  Set it with 'setcomp'\n");
    }
}



sub listcomp($@) {
    my ($database, @args) = @_;

    if (@args > 0) {
        print("'listcomp' has no arguments.  Ignoring arguments\n");
    }
    my %componentsInfo = $database->componentsInfo();

    my $format = "%-20.20s %-20.20s %-7.7s %-8.8s\n";
    print(scalar(keys(%componentsInfo)) . 
          " components in database:\n");
    printf($format, "COMPONENT NAME", "COMPONENT IR CODE", 
           "CODELEN", "PROTOCOL");
    printf($format, "---------------------------------",
           "--------------------------------",
           "--------------------------------------",
           "-------", "-------");
    foreach my $compName (sort(keys(%componentsInfo))) {
        printf($format, $compName, 
               $componentsInfo{$compName}{COMPONENT_CODE},
               $componentsInfo{$compName}{CODELENGTH},
               $componentsInfo{$compName}{PROTOCOL},
               );
    }
}



sub listcmd($@) {

    my ($database, @args) = @_;

    if (@_ > 0) {
        print("'listcmd' has no arguments.  Ignoring arguments\n");
    }

    if (!defined($currentComponentName)) {
        print("You have not set the current component name.\n");
        print("Use 'setcomp' to do so.\n");
    } elsif (!defined($database->componentInfo($currentComponentName))) {
        print("Current component '$currentComponentName' is not a known " .
              "component.\n");
        print("Use 'learncomp' to create it.\n");
    } else {
        print("Commands defined for component '$currentComponentName':\n\n");
        my $format = "%-20.20s %-40.40s\n";
        printf($format, "COMMAND", "COMPLETE IR CODE");
        printf($format, "-----------------------------",
               "------------------------------------");
        my %commandsInfo = $database->commandsInfo($currentComponentName);

        foreach my $commandName (sort(keys(%commandsInfo))) {
            my $irCode = $commandsInfo{$commandName};
            if (!defined($irCode)) {
                print("Database error: undefined ir code\n");
            } else {
                printf($format, $commandName, $irCode);
            }
        }
    }
}



sub learnCompFromMessage($$$) {
    my ($database, $irMessage, $componentName) = @_;

#        print Data::Dumper->Dump([ \$irMessage ], [ "irMessage" ]);

    $database->interpretIrMessage($irMessage, 
                                  \my $msgCompName, \my $msgCommandName, 
                                  \my $error);
    
    if ($error) {
        print("Unable to interpret IR message.  $error\n");
    } else {
        if (defined($database->componentInfo($componentName))) {
            if (!defined($msgCompName)) {
                print("The code received is not for component " .
                      "'$componentName.'\n");
                print("It is not for any known component.\n");
            } elsif ($msgCompName ne $componentName) {
                print("The code received is not for component " .
                      "'$componentName.'\n");
                print("It is for component $msgCompName\n");
            } else {
                $database->averageInComponent($componentName, $irMessage);
                print(${$database->componentInfo($componentName)}{WEIGHT} .
                    " samples now in " .
                    "database for component '$componentName'\n");
            }
        } else {
            if (defined($msgCompName)) {
                print("Component '$componentName' is not yet known, " .
                      "but the code received is for the " .
                      "already known component $msgCompName.  Ignored.\n");
            } else {
                $database->addNewComponent($componentName, $irMessage);
                print("New component '$componentName' added.\n");
            }
        }
    }
}



sub acquireMessageFromSlinke($$$) {
    my ($messager, $irMessageR, $errorR) = @_;
#-----------------------------------------------------------------------------
#  Receive an IR message from the Slink-e, waiting for one if necessary.
#  Discard any non-IR messages received in the meantime.
#
#  Return a slightly interpreted description of the IR message --
#  identifying the head and tail segments and IR code and such.  But
#  without using any IR database information -- just based on the information
#  in the message.
#-----------------------------------------------------------------------------
    print("Acquiring message from Slink-e...\n");
    receiveIrMessage($messager, \my $pulseTrain, \my $zone, \my $error);
    
    if ($error) {
        $$errorR = "Failed to receive an IR message.  $error";
    } elsif (!$pulseTrain) {
        $$errorR = "Wait for a message interrupted before message received.";
    } else {
        print("Message received from zone $zone\n");
        
        Slinke::Ircode::decodeIrMessage
            ($pulseTrain, \my $irMessage, \my $error);
        
        if ($error) {
            $$errorR = "Unable to decode the received message.  $error.";
        } else {
            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}";
            } 
            $$irMessageR = $irMessage;
        } 
    }
}


sub learncomp($$@) {
    my ($database, $messager, @args) = @_;
    my ($componentName, $rest) = @args;
#-----------------------------------------------------------------------------
#  Perform the 'learncomp' command.
#
#  Get an IR code from the Slink-e and average the characteristics of it
#  into those in the database for the component named $componentName.
#
#  If we don't already have a component by that name, create it using the
#  characteristics of the code we receive.
#
#  If we do already know the component by that name and the code 
#  received is not for that component, issue an error message and leave
#  the database unchanged.
#-----------------------------------------------------------------------------
    if (!defined($componentName) || defined($rest)) {
        print("Wrong number of arguments.  'learncomp' takes one argument: " .
              "a component name\n");
    } else {
        $currentComponentName = $componentName;

        acquireMessageFromSlinke($messager, \my $irMessage, \my $error);
        if ($error) {
            print("Nothing from which to learn.  $error.\n");
        } else {
            learnCompFromMessage($database, $irMessage, $componentName);
        }
    }
}



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

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



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}
             );
    } else {
        $retval = $FALSE;
    }
}



sub showPulses($) {

    my ($pulseTrain) = @_;

    my ($pulsesOnLine, $sum);

    $pulsesOnLine = 0;
    $sum = 0;
    
    print("Pulses:    ");   
    foreach (@{$pulseTrain}) {
        if ($pulsesOnLine >= 10) {
            print("\n");
            print("           ");
            $pulsesOnLine = 0;
        }
        printf("%+5d ", $_);
        $sum += abs($_);
        ++$pulsesOnLine;
    }
    print("\n");
    print("Tot time:  " . $sum/1e6 . "s\n");
}



sub showCode($) {

    my ($irMessage) = @_;
    
    print("IR code:   ");
    if (defined($irMessage->{CODE})) {
        my $bits = length($irMessage->{CODE});
        print("$irMessage->{CODE} ($bits bits)\n");
        if (defined($irMessage->{IRCODE_FMT})) {
            print("Format:    $irMessage->{IRCODE_FMT}\n");
        }
    } else {
        print("none\n");
    }
}



sub displayInterpretedIrMessage($$$) {

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

    if (!defined($irMessage->{COMPONENT_CODE})) {
        print("The IR message received has an unrecognized format.  " .
              "Can't tell what the component code is\n");
    } else {
        my $msgCompName = 
            $database->compNameFromCode($irMessage->{COMPONENT_CODE});

        print("Component: ");
        if (!defined($msgCompName)) {
            print("UNKNOWN: $irMessage->{COMPONENT_CODE}");
        } else {
            print($msgCompName);
            recordHistory(\$msgHistory{$zone}, $msgCompName);
        }
        print("\n");

        $database->lookupCommandCode($msgCompName, $irMessage->{COMMAND_CODE},
                                     \my $msgCommandName, \my $error);
        
        if ($error) {
            print("Invalid command code for component '$msgCompName'.  " .  
                  "$error.\n");
        } else {
            print("Command:   ");
            if (!defined($msgCommandName)) {
                print("UNKNOWN: $irMessage->{COMMAND_CODE}");
            } else {
                print($msgCommandName);
            }
            print("\n");
        }
    }
}



sub interpretAndDisplay($$$$$) {
    my ($database, $pulseTrain, $verbose, $showcode, $zone) = @_;

    # TODO: We shouldn't be passing $zone in here.  Need to handle
    # continuation messages some other way.
    
    Slinke::Ircode::decodeIrMessage
       ($pulseTrain, \my $irMessage, \my $error);
    if ($error) {
        print("Unable to decode the received message.  $error.\n");
    } else {
        if ($verbose) {
            print(Data::Dumper->Dump([ \$irMessage ], [ "code" ]));
        }
        
        if ($showcode) {
            showCode($irMessage);
        }
        displayInterpretedIrMessage($database, $irMessage, $zone);
    }
}



sub getirmsg($$@) {

    my ($database, $messager, @args) = @_;

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

    local @ARGV = @args;  # GetOptions takes input from @ARGV only
    my %cmdline = ();
    my $validOptions = GetOptions(\%cmdline,
                                  "showcode",
                                  "showpulse",
                                  "verbose",
                                  "continuous",
                                  );
    if (!$validOptions) {
        print("Invalid 'getirmsg' command options\n");
    } elsif (@ARGV > 0) {
        print("'getirmsg' has no arguments.\n");
    } else {
        my $done;
        
        $done = $FALSE;

        while (!$done) { 
            print("Acquiring message from Slink-e...\n");
            receiveIrMessage($messager, \my $pulseTrain, \my $zone, 
                             \my $error);
            
            if ($error) {
                print("Receive of IR message from device failed.  $error\n");
                $done = $TRUE;
            } elsif (!defined($pulseTrain)) {
                print("Wait for a message interrupted before " .
                      "message received.\n");
                $done = $TRUE;
            } else {
                print("Zone:      $zone\n");  

                if ($cmdline{"showpulse"}) {
                    showPulses($pulseTrain);
                }
                if (isContinuation($database, $pulseTrain, $zone)) {
                    print("CONTINUE\n");
                    recordHistory(\$msgHistory{$zone}, 
                                  $msgHistory{$zone}->{COMPNAME});
                } else {
                    interpretAndDisplay($database, $pulseTrain, 
                                        $cmdline{"verbose"},
                                        $cmdline{"showcode"}, $zone);
                }
            }
            if (!$cmdline{"continuous"}) {
                $done = $TRUE;
            }
        }
    }
}



sub delcomp($@) {

    my ($database, @args) = @_;
    my ($componentName, $rest) = @args;

    if (!defined($componentName) || defined($rest)) {
        print("Wrong number of arguments.  'delcomp' takes one argument: " .
              "a component name\n");
    } else {
        my $error;
        $database->deleteComponent($componentName, \$error);
        if (defined($error)) {
            print ("Failed.  $error\n");
        } else {
            print("Component '$componentName' deleted.\n");
        }            
    }
}



sub delcmd($@) {
    my ($database, @args) = @_;

    my ($commandName, $rest) = @args;

    my $compName = $currentComponentName;

    if (!defined($commandName) || defined($rest)) {
        print("Wrong number of arguments.  'delcmd' takes one argument: " .
              "a command name\n");
    } else {
        if (!defined($compName)) {
            print("You have not set the current component name.\n");
            print("Use 'learncomp' or 'setcomp' to do so.\n");
        } else {
            my $error;
            $database->deleteCommand($compName, $commandName, \$error);
            if ($error) {
                print("Failed.  $error\n");
            } else {
                print("Command '$commandName' for component '$compName' " .
                      "deleted.\n");
            }
        }
    }
}



sub zoneList($) {
    my ($zoneMask) = @_;
#-----------------------------------------------------------------------------
#  Generate a list of zones specified by the port mask $zoneMask, for
#  use in a message.
#-----------------------------------------------------------------------------
    my $list;

    $list = "";

    foreach my $zone (0..7) {
        if ($zoneMask & (1 << $zone)) {
            if ($list ne "") {
                $list .= " ";
            }
            $list .= "$zone";
        }
    }

    my $retval;
    if ($list eq "") {
        $retval = "(none)";
    } else {
        $retval = $list;
    }
    return $retval;
}



sub setIrZone($$$$$) {

    my ($slinke, $direction, $oldZoneMask, $zone, $action) = @_;

    my $newZoneMask;
    if ($action eq "ENABLE") {
        $newZoneMask = $oldZoneMask | 1 << $zone;
    } elsif ($action eq "DISABLE") {
        $newZoneMask = $oldZoneMask & ~(1 << $zone);
    } else {
        die("INTERNAL ERROR: Invalid \$action value: $action");
    }
    
    my $error;
    if ($direction eq "TRANSMIT") {
        $slinke->setIRTransmitZones(ZONEMASK => $newZoneMask,
                                    ERROR    => \$error,
                                    );
    } else {
        $slinke->setIRReceiveZones(ZONEMASK => $newZoneMask,
                                   ERROR    => \$error,
                                   );
    }
    if ($error) {
        print("Failed to set new zone mask $newZoneMask.  $error");
    } else {
        print("$direction now enabled in these zones: ",
              zoneList($newZoneMask), "\n");
    }
}



sub doIrzone($$$$) {

    my ($slinke, $direction, $action, $zone) = @_;

    my $oldZoneMask;
    my $error;
    if ($direction eq "TRANSMIT") {
        $slinke->getIRTransmitZones(ZONEMASK => \$oldZoneMask,
                                    ERROR    => \$error,
                                    );
    } else {
        $slinke->getIRReceiveZones(ZONEMASK => \$oldZoneMask,
                                   ERROR    => \$error,
                                   );
    }
    if ($error) {
        print("Unable to read existing zone mask from Slink-e.  $error\n");
    } else {
        if ($action eq "QUERY") {
            print("$direction enabled in these zones:  ",
                  zoneList($oldZoneMask), "\n");
        } else {
            setIrZone($slinke, $direction, $oldZoneMask, $zone, $action);
        }
    }
}



sub irzone($@) {
    my ($slinke, @args) = @_;

    my ($directionarg, $statearg, $zonearg, $rest) = @args;

    my $zone;
    my $direction;
    my $action;

    if (!defined($directionarg) || defined($rest) ||
        (defined($statearg) && !defined($zonearg))) {
        print("Wrong number of arguments.  'irzone' takes 1 or 3 " .
              "arguments:  A direction ('transmit' or 'receive'), " .
              "and an optional zone number and new state " .
              "('enable' or 'disable')\n");
    } else {
        if ($directionarg eq "transmit") {
            $direction = "TRANSMIT";
        } elsif ($directionarg eq "receive") {
            $direction = "RECEIVE";
        } else {
            print("Invalid direction keyword '$directionarg'.  " .
                  "Must be 'transmit' or 'receive'.\n");
        }
        if (!defined($statearg)) {
            $action = "QUERY";
        } elsif ($statearg eq "enable") {
            $action = "ENABLE";
        } elsif ($statearg eq "disable") {
            $action = "DISABLE";
        } else {
            print("Invalid state keyword '$statearg'.  " .
                  "Must be 'enable' or 'disable'.\n");
        }
        if (defined($zonearg)) {
            if (!iswhole($zonearg)) {
                print("Zone '$zonearg' is not a whole decimal number.\n");
            } elsif ($zonearg < 0 || $zonearg > 7) {
                print("Zone number $zonearg is not in the range 0..7\n");
            } else {
                $zone = $zonearg;
            }
        }
    }
    if (defined($direction) && defined($action)) {
        doIrzone($slinke, $direction, $action, $zone);
    } else {
        print("Invalid irzone command.\n");
    }
}



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

    $slinke->getIRCarrier(CARRIERFREQ => \my $carrierInfo,
                          ERROR       => \my $error);
    
    if ($error) {
        $$errorR = "Slinke::Control::getIRCarrier() failed.  $error";
    } else {
        if (!isnumber($carrierInfo)) {
            $$errorR = "Slinke::Control::getIRCarrier() returned " .
                "garbage: '$carrierInfo'";
        } elsif ($carrierInfo < 0) {
            $$errorR = "Slinke::Control::getIRCarrier() returned " .
                "garbage (negative number): '$carrierInfo'";
        } else {
            if ($carrierInfo != 0) {
                $$carrierFreqR = $carrierInfo;
            }
        }
    }
}            



sub doGetIrCarrier($) {
    
    my ($slinke) = @_;

    getIrCarrier($slinke, \my $carrierFreq, \my $error);

    if ($error) {
        print("Failed to get carrier info.  $error\n");
    } else {
        if (defined($carrierFreq)) {
            print("Carrier frequency is $carrierFreq hz\n");
        } else {
            print("Carrier is not being used\n");
        }
    }
}



sub doSetIrCarrier($$) {

    my ($slinke, $arg) = @_;

    my $slinkeArg;

    if ($arg eq "off") {
        $slinkeArg = 0;
    } else {
        if (!iswhole($arg)) {
            print("Invalid argument '$arg'.  " .
                  "Must be either a whole number or 'off'.\n");
        } else {
            $slinkeArg = $arg;
        }
    }
    if (defined($slinkeArg)) {
        $slinke->setIRCarrier(REQCARRIERFREQ => $slinkeArg,
                              CARRIERFREQ    => \my $carrierInfo,
                              ERROR          => \my $error);
        
        if ($error) {
            print("Failed.  Slinke::Control::setIRCarrier() failed.  " .
                  "$error\n");
        } else {
            if (!iswhole($carrierInfo)) {
                print("Slinke::Control::setIRCarrier() returned " .
                      "garbage: '$carrierInfo'");
            } else {
                if ($carrierInfo == 0) {
                    print("Carrier is now not being used\n");
                } else {
                    print("Carrier frequency is now $carrierInfo Hz\n");
                }
            }
        }
    }
}



sub ircarrier($@) {
    my ($slinke, @args) = @_;

    my ($arg, $rest) = @args;

    if (defined($rest)) {
        print("Too many arguments.  'ircarrier' takes 1 optional argument: " .
              "the carrier frequency (in hertz) or 'off'.\n");
    } else {
        if (defined($arg)) {
            doSetIrCarrier($slinke, $arg);
        } else {
            doGetIrCarrier($slinke);
        }
    }
}



sub doGetIrTimeout($) {
    
    my ($slinke) = @_;

    $slinke->getIRTimeoutPeriod(PERIOD => \my $timeoutSamplePeriods,
                                ERROR  => \my $error);
            
    if ($error) {
        print("Slinke::Control::getIRTimeoutPeriod() failed.  $error\n");
    } else {
        if (!iswhole($timeoutSamplePeriods)) {
            print("Slinke::Control::getIRTimeoutPeriod() returned " .
                  "garbage: '$timeoutSamplePeriods'\n");
        } else {
            print("Timeout is $timeoutSamplePeriods sample periods\n");
        }
    }
}



sub doSetIrTimeout($$) {

    my ($slinke, $arg) = @_;

    my $slinkeArg;

    if (!isnatural($arg)) {
        print("Invalid argument '$arg'.  Must be a natural number.\n");
    } else {
        my $maxTimeout = 65535;

        if ($arg > $maxTimeout) {
            print("Timeout is too long.  Maximum value is 65535 sample " .
                  "periods.\n");
        } else {
            my $samplePeriods = $arg;
            $slinke->setIRTimeoutPeriod(PERIOD => $samplePeriods,
                                        ERROR  => \my $error);
        
            if (defined($error)) {
                print("Failed.  " .
                      "Slinke::Control::setIRTimeoutPeriod() failed.  " .
                      "$error\n");
            } else {
                print("Timeout period set to $samplePeriods " .
                      "sample periods\n");
            }
        }
    }
}



sub irtimeout($@) {
    my ($slinke, @args) = @_;

    my ($arg, $rest) = @args;

    if (defined($rest)) {
        print("Too many arguments.  'irtimeout' takes 1 optional argument: " .
              "the timeout period (in sample periods).\n");
    } else {
        if (defined($arg)) {
            doSetIrTimeout($slinke, $arg);
        } else {
            doGetIrTimeout($slinke);
        }
    }
}



sub doGetIrMinLength($) {
    
    my ($slinke) = @_;

    $slinke->getIRMinimumLength(MINLENGTH => \my $minLength,
                                ERROR     => \my $error);
            
    if ($error) {
        print("Slinke::Control::getIRMinimumLength() failed.  $error\n");
    } else {
        if (!iswhole($minLength)) {
            print("Slinke::Control::getIRMinimumLength() returned " .
                  "garbage: '$minLength'\n");
        } else {
            print("Minimum message length is set to $minLength bytes.\n");
        }
    }
}



sub doSetIrMinLength($$) {

    my ($slinke, $arg) = @_;

    my $slinkeArg;

    if (!iswhole($arg)) {
        print("Invalid argument '$arg'.  Must be a whole number.\n");
    } else {
        if ($arg > 15) {
            print("Timeout is too long.  Maximum value is 15 bytes.\n");
        } else {
            $slinke->setIRMinimumLength(MINLENGTH => $arg,
                                        ERROR     => \my $error,
                                        );
            
            if ($error) {
                print("Failed.  $error");
            } else {
                print("Minimum message length is now set to " .
                      "$arg bytes.\n");
            }
        }
    }
}



sub irminlength($@) {
    my ($slinke, @args) = @_;

    my ($arg, $rest) = @args;

    if (defined($rest)) {
        print("Too many arguments.  " .
              "'irminlength' takes 1 optional argument: " .
              "the minimum message length in bytes\n");
    } else {
        if (defined($arg)) {
            doSetIrMinLength($slinke, $arg);
        } else {
            doGetIrMinLength($slinke);
        }
    }
}



sub doGetIrSamplePeriod($) {
    
    my ($slinke) = @_;

    $slinke->getIRSamplingPeriod(PERIOD => \my $period, 
                                 ERROR  => \my $error);
            
    if ($error) {
        print("Slinke::Control::setIRSamplingPeriod() failed.  $error\n");
    } else {
        if (!isnumber($period)) {
            print("Slinke::Control::getIRSamplingPeriod() returned " .
                  "garbage: '$period'\n");
        } else {
            print("IR sample period is set to " . $period * 1E6 .
                  " microseconds.\n");
        }
    }
}



sub doSetIrSamplePeriod($$) {

    my ($slinke, $arg) = @_;

    my $slinkeArg;

    if (!iswhole($arg)) {
        print("Invalid argument '$arg'.  Must be a whole number.\n");
    } else {
        if ($arg > 1000) {
            print("Sample period is too long.  " .
                  "Maximum value is 1000 microseconds.\n");
        } elsif ($arg < 50) {
            print("Sample period is too short.  " .
                  "Minimum value is 50 microseconds.\n");
        } else {
            $slinke->setIRSamplingPeriod(PERIOD => $arg/1e6,
                                         ERROR  => \my $error,
                                         );
            
            if ($error) {
                print("Failed.  $error");
            } else {
                print("IR sample period is now set to " .
                      "$arg microseconds.\n");
            }
        }
    }
}



sub irsampleperiod($@) {
    my ($slinke, @args) = @_;

    my ($arg, $rest) = @args;

    if (defined($rest)) {
        print("Too many arguments.  " .
              "'irsampleperiod' takes 1 optional argument: " .
              "the sample period in microseconds\n");
    } else {
        if (defined($arg)) {
            doSetIrSamplePeriod($slinke, $arg);
        } else {
            doGetIrSamplePeriod($slinke);
        }
    }
}



sub getYNFromUser($$) {
    my ($prompt, $default) = @_;

    my $validatedDefault;
    if (!defined($default)) {
        $validatedDefault = "NONE";
    } else {
        if ($default eq "Y") {
            $validatedDefault = "Y";
        } elsif ($default eq "N") {
            $validatedDefault = "N";
        } else {
            $validatedDefault = "NONE";
        }
    }
        
    my $answer;

    while (!defined($answer)) {
        my $y = $validatedDefault eq "Y" ? "Y" : "y";
        my $n = $validatedDefault eq "N" ? "N" : "n";

        print "$prompt [$y/$n]: ";
        my $val = lc( <STDIN> );
        chomp $val;
        if ($val eq "" && $validatedDefault ne "NONE") {
            $answer = $validatedDefault;
        } elsif ($val eq "y") {
            $answer = "Y";
        } elsif ($val eq "n") {
            $answer = "N";
        } else {
            print("Invalid response.  " .
                  "Must answer 'y' or 'n'",
                  $validatedDefault ne "NONE" ? " or null" : "",
                  ".\n");
        }
    }
    return($answer);
}



sub learnCmdFromMessage($$$$) {

    my ($database, $irMessage, $compName, $commandName) = @_;
    
    if (!defined($irMessage->{COMPONENT_CODE})) {
        print("The IR message received has an unrecognized format.  " .
              "Can't tell what the component code is.\n");
    } else {
        my $msgCompName = 
            $database->compNameFromCode($irMessage->{COMPONENT_CODE});

        if (!defined($msgCompName)) {
            print("The IR message received is not for " .
                  "the current component '$compName'.  " .
                  "It is for an unknown component " .
                  "with component code $irMessage->{COMPONENT_CODE}\n");
        } elsif ($msgCompName ne $compName) {
            print("The IR message received is not for the current " .
                  "component '$compName'.  " .
                  "It is for '$msgCompName'.\n");
        } else {
            $database->lookupCommandCode($msgCompName, 
                                         $irMessage->{COMMAND_CODE},
                                         \my $msgCommandName, \my $error);
            if ($error) {
                print("This messsage contains a command code that is " .
                      "not valid for Component '$msgCompName'.  $error.\n");
            } else {
                if (defined($msgCommandName)) {
                    print("The IR message received is for the already known " .
                          "command '$msgCommandName' " .
                          "for component '$compName'.\n");
                } else {
                    $database->addNewCommand($compName, $commandName, 
                                             $irMessage->{COMMAND_CODE}, 
                                             \my $error);
                    if ($error) {
                        print("Unable to add command '$commandName' for " .
                              "component '$compName' with command code " .
                              "$irMessage->{COMMAND_CODE}.  $error\n");
                    }
                }
            }
        }
    }
}



sub learnit($$$$) {
    my ($database, $messager, $compName, $commandName) = @_;
#-----------------------------------------------------------------------------
#  Perform the 'learn' command for command $commandName of component
#  $compName.  Get the IR message for the command from the slinke
#  messager object $messager and use the IR database $database.
#-----------------------------------------------------------------------------
    acquireMessageFromSlinke($messager, \my $irMessage, \my $error);
    if ($error) {
        print("Nothing from which to learn.  $error\n");
    } else {
        learnCmdFromMessage($database, $irMessage, $compName, $commandName);
    }
}



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

    local @ARGV = @args;  # GetOptions takes input from @ARGV only
    my %cmdline = ();
    my $validOptions = GetOptions(\%cmdline,
                                  );
    if (!$validOptions) {
        print("Invalid 'learncmd' command options\n");
    } else {
        my ($commandName, $rest) = @ARGV;

        my $compName = $currentComponentName;

        if (!defined($commandName)) {
            print("Need command name argument\n");
        } elsif (defined($rest)) {
            print("Extra arguments: '$rest'\n");
        } else {
            if (!defined($compName)) {
                print("You have not set the current component name.\n");
                print("Use 'learncomp' or 'setcomp' to do so.\n");
            } elsif (defined($database->getIrCode($compName, $commandName))) {
                print("The command '$commandName' for component '$compName' " .
                      "is already known.\n");
            } else {
                learnit($database, $messager, $compName, $commandName);
            }
        }
    }
}



sub verifyReceived($$$$) {
    my ($database, $messager, $compName, $commandName) = @_;
#-----------------------------------------------------------------------------
#  Receive an IR message and verify that it contains the IR code 
#  for command $commandName of component $compName.
#-----------------------------------------------------------------------------
    my $transmittedIrCode = $database->getIrCode($compName, $commandName);

    receiveIrMessage($messager, \my $pulseTrain, \my $zone, \my $error);
 
    if ($error) {
        print("Receive of IR message from device failed.  $error\n");
    } elsif (!$pulseTrain) {
        print("Wait for IR message interrupted before message received.\n");
    } else {
        Slinke::Ircode::decodeIrMessage
            ($pulseTrain, \my $irMessage, \my $error);
        
        if ($error) {
            print("Unable to decode the IR message received back.  $error.\n");
        } else {
            if (!defined($irMessage->{CODE})) {
                print ("No IR code present in IR message received back.\n");
            } else {
                my $receivedIrCode = $irMessage->{CODE};
                if ($receivedIrCode ne $transmittedIrCode) {
                    print("Received different IR code from that sent.\n");
                    print("Sent: $transmittedIrCode\n");
                    print("Got:  $receivedIrCode\n");
                } else {
                    print("VERIFIED: Received back code from " .
                          "component '$compName', " .
                          "command '$commandName'\n");
                }
            }
        }
    }
}



sub playit($$$$%) {
    my ($database, $messager, $compName, $commandName, %options) = @_;
#-----------------------------------------------------------------------------
#  Perform the 'playcmd' command for command $commandName of component
#  $compName, according to command options %options.
#
#  Use Slinke::Messager object $messager and IR database $database.
#-----------------------------------------------------------------------------

    $database->sendIrMessage(SLINKEMSGR => $messager,
                             COMPONENT  => $compName,
                             COMMAND    => $commandName,
                             COUNT      => $options{"count"},
                             WANTFEEDBACK => $options{"verify"},
                             ZONES      => \@playZones,
                             ERROR      => \my $error,
                             );

    if ($error) {
        print("Failed to send IR message.  $error\n");
    } else {
        if ($options{"verify"}) {
            verifyReceived($database, $messager, $compName, $commandName);
        }
    }
}



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

    local @ARGV = @args;  # GetOptions takes input from @ARGV only
    my %cmdline = ();
    my $validOptions = GetOptions(\%cmdline,
                                  "count=i",
                                  "verify",
                                  );
    if (!$validOptions) {
        print("Invalid 'playcmd' command options\n");
    } else {
        if (defined($cmdline{'count'}) && $cmdline{'count'} < 1) {
            print("-count value must be at least 1.\n");
        } else {
            my ($commandName, $rest) = @ARGV;
            
            if (!defined($commandName) || defined($rest)) {
                print("Wrong number of arguments.  " .
                      "'playcmd' takes one argument: " .
                      "a command name\n");
            } else {
                my $compName = $currentComponentName;
                
                if (!defined($compName)) {
                    print("You have not set the current component name.\n");
                    print("Use 'setcomp' to do so.\n");
                } else {
                    playit($database, $messager, $compName, $commandName, 
                           %cmdline);
                }
            }
        }            
    }
}



sub timeit($$$%) {
    my ($database, $compName, $commandName, %options) = @_;
#-----------------------------------------------------------------------------
#  Perform the 'timecmd' command for command $commandName of component
#  $compName, according to command options %options.
#
#  Use IR database $database.
#-----------------------------------------------------------------------------

    $database->timeIrMessage(COMPONENT  => $compName,
                             COMMAND    => $commandName,
                             COUNT      => $options{"count"},
                             PERIOD     => \my $period,
                             ERROR      => \my $error,
                             );

    if ($error) {
        print("Failed to compute the time.  $error\n");
    } else {
        printf("With intermessage pauses, total time is %1.6f seconds\n",
               $period);
    }
}



sub timecmd($@) {
    my ($database, @args) = @_;

    local @ARGV = @args;  # GetOptions takes input from @ARGV only
    my %cmdline = ();
    my $validOptions = GetOptions(\%cmdline,
                                  "count=i",
                                  );
    if (!$validOptions) {
        print("Invalid 'timecmd' command options\n");
    } else {
        if (defined($cmdline{'count'}) && $cmdline{'count'} < 1) {
            print("-count value must be at least 1.\n");
        } else {
            my ($commandName, $rest) = @ARGV;
            
            if (!defined($commandName) || defined($rest)) {
                print("Wrong number of arguments.  " .
                      "'timecmd' takes one argument: " .
                      "a command name\n");
            } else {
                my $compName = $currentComponentName;
                
                if (!defined($compName)) {
                    print("You have not set the current component name.\n");
                    print("Use 'setcomp' to do so.\n");
                } else {
                    timeit($database, $compName, $commandName, %cmdline);
                }
            }
        }            
    }
}



sub playzone {

    my @args = @_;

    my ($zone, $verb, $rest) = @args;
    
    if (!defined($zone)) {
        print("Playing enabled in " . scalar(@playZones) . " zones:  " .
              join(',',sort(@playZones)) . "\n");
    } else {
        if (!iswhole($zone)) {
            print("Zone argument '$zone' is not a whole number.\n");
        } elsif ($zone > 7) {
            print("Zone $zone is too high.  Highest zone is 7.\n");
        } elsif (defined($verb) &&
                 $verb ne "enable" && $verb ne "disable") {
            print("'$verb' is invalid.  " .
                  "Must be 'enable' or 'disable' or nothing\n");
        } elsif (defined($rest)) {
            print("Too many arguments.  " .
                  "Zone number and action are only args\n");
        } else {
            if (!defined($verb)) {
                print("Zone $zone is " . 
                      (presentInSet($zone, \@playZones) ? 
                       "enabled" : "disabled") . "\n");
            } else {
                if ($verb eq "enable") {
                    addToSet($zone, \@playZones);
                } else {
                    delFromSet($zone, \@playZones);
                }
            }
        }
    }
}



sub ctlDisplayCommands() {
    print( <<ENDLIST

Commands: 
  help
  irzone
  ircarrier
  irtimeout
  irminlength
  irsampleperiod
ENDLIST
           );
}



sub ctlHelp(@) {

    my ($topic, $rest) = @_;

    my %help = (
                "help" => <<ENDHELP
Gives help on ctl subcommands.

  ctl help <command>

With no arguments, lists all ctl subcommands
ENDHELP
                ,
                "irzone" => <<ENDHELP
Sets and queries the enabled status of an IR zone for transmitting or
receiving IR messages.

  ctl irzone {transmit|receive} [ { enable | disable} <zone> ]

If you don't specify the zone and enable or disable, this command
displays the current setting.

This command concerns settings in the Slink-e itself.
ENDHELP
                 ,
                "ircarrier" => <<ENDHELP
Sets and queries the IR carrier frequency, and the carrier/no carrier
mode.  This command concerns settings in the Slink-e itself.

  ctl ircarrier [<hz> | off]

<hz> is the carrier frequency is hertz, e.g. 40000 and implies carrier on
mode.

"off" means carrier off mode.

With no arguments, the command displays the current setting.

This command concerns settings in the Slink-e itself.
ENDHELP
                 ,
                "irtimeout" => <<ENDHELP
Sets and queries the timeout period for IR receives.  I.e. the duration of 
off pulse that the Slink-e considers to be an intermessage pause.
This command concerns settings in the Slink-e itself.

  ctl irtimeout [<sample_periods>]

<sample_periods> is the timeout period in sample periods.  E.g. if the
sample period is 100 microseconds and you want the timeout period to be
50000 microseconds, make <sample_periods> 500.

With no arguments, the command displays the current setting.

This command concerns settings in the Slink-e itself.
ENDHELP
                 ,

                "irminlength" => <<ENDHELP
Sets and queries the minimum IR pulse set length the Slink-e observes.
The Slink-e itself will ignore any IR pulse set it receives shorter
than this.  The length is measured in the number of bytes of port
message data the Slink-e would use to describe the pulse set.  This
command concerns settings in the Slink-e itself.

  ctl irminlength [<bytes>]

<bytes> is the minimum message length in "bytes."

With no arguments, the command displays the current setting.
ENDHELP
                 ,
                "irsampleperiod" => <<ENDHELP
Sets and queries the IR sampling period in the Slink-e.

When the Slink-e generates an IR message, it generates IR pulses
in multiples of this period.

In receiving IR messages, the Slink-e samples the IR sensors for presence
of IR carrier at intervals equal to this period.

This value also affects the way a pulse set is described in port
message data sent to or received from the Slink-e.  In port message
data, lengths of time are expressed in units of the sample period (3
sample periods, 4 sample periods, etc.).

For this reason, you must be especially careful setting the IR sampling
period with this command.  It can cause higher level 'slinke' commands
to malfunction, since the higher level assumes the sampling period stays
set to whatever it sets it to.

  ctl irsampleperiod [<microseconds>]

<microseconds> is the sample period in microseconds.

With no arguments, the command displays the current setting.
ENDHELP
                 ,
                 );

    if (!defined($topic)) {
        ctlDisplayCommands();
    } else {
        if (defined($help{$topic})) {
            print($help{$topic});
        } else {
            print("No help available for topic '$topic'\n");
        }
    }        
    print("\n");

}



sub ctl($@) {
    my ($slinke, @args) = @_;
    
    my ($verb, @subargs) = @args;

    if (!defined($verb)) {
        print("You need to specify at least a subcommand name as an " .
              "argument to 'ctl'\n");
    } else {
        if ($verb eq "help") {
            ctlHelp(@subargs);
        } elsif ($verb eq "irzone") {
            irzone($slinke, @subargs);
        } elsif ($verb eq "ircarrier") {
            ircarrier($slinke, @subargs);
        } elsif ($verb eq "irtimeout") {
            irtimeout($slinke, @subargs);
        } elsif ($verb eq "irminlength") {
            irminlength($slinke, @subargs);
        } elsif ($verb eq "irsampleperiod") {
            irsampleperiod($slinke, @subargs);
        } else {
            print("Invalid 'ctl' subcommand: '$verb'\n");
        }
    }
}



sub commandLoop($$$$) {

    my ($slinke, $messager, $term, $database) = @_;

    my $wantquit;

    $wantquit = $FALSE;

    while (!$wantquit) {

        my $command = $term->readline("slinke>");

        if (!defined($command)) {
            print("\n");
            $wantquit = $TRUE;
        } else {
            chomp($command);

            my ($verb, @args) = split(/ /, $command);

            if (defined($verb)) {
                if ($verb eq "quit") {
                    $wantquit = $TRUE;
                } elsif ($verb eq "help") {
                    help(@args);
                } elsif ($verb eq "save") {
                    save($database, @args);
                } elsif ($verb eq "revert") {
                    revert($database, @args);
                } elsif ($verb eq "learncomp") {
                    learncomp($database, $messager, @args);
                } elsif ($verb eq "learncmd") {
                    learncmd($database, $messager, @args);
                } elsif ($verb eq "setcomp") {
                    setcomp(@args);
                } elsif ($verb eq "showcomp") {
                    showcomp(@args);
                } elsif ($verb eq "listcomp") {
                    listcomp($database, @args);
                } elsif ($verb eq "listcmd") {
                    listcmd($database, @args);
                } elsif ($verb eq "getirmsg") {
                    getirmsg($database, $messager, @args);
                } elsif ($verb eq "playcmd") {
                    playcmd($database, $messager, @args);
                } elsif ($verb eq "timecmd") {
                    timecmd($database, @args);
                } elsif ($verb eq "delcomp") {
                    delcomp($database, @args);
                } elsif ($verb eq "delcmd") {
                    delcmd($database, @args);
                } elsif ($verb eq "playzone") {
                    playzone(@args);
                } elsif ($verb eq "ctl") {
                    ctl($slinke, @args);
                } else {
                    print("Unrecognized command verb: '$verb'\n");
                }
            }
        }
    }
}



sub accessSlinke($$$$$$) {
    my ($deviceFileName, $noReset, $debugLevel, $slinkeR, $messagerR,
        $errorR) = @_;
#-----------------------------------------------------------------------------
#  Create and return a Slinke::Control object and Slinke::Messager object 
#  for the Slink-e.
#
#  Initialize the device and print information about it to Standard Output.
#
#  Enable transmitting and receiving in all zones.  That's to minimize
#  the chance of the naive user getting a frustrating total lack of response.
#
#  (The Slink-e itself comes up with transmit enabled in all zones, but
#  receive enabled only in Zone 0).
#-----------------------------------------------------------------------------
    if (!defined($deviceFileName)) {
        die("undefined device file name passed to accessSlinke()");
    }
    print("Accessing Slink-e attached as '$deviceFileName'...\n");
    print("\n");

    Slinke::Control->createObject(SLINKE => \my $slinke,
                                  DEVICE => $deviceFileName, 
                                  DEBUG  => $debugLevel,
                                  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.  " .
              "Baud rate = " . $slinke->baudrate() . "\n");

        $slinke->getVersion(VERSION => \my $slinkeVersion,
                            ERROR   => \my $error);
        if ($error) {
            $$errorR = "Unable to get 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");
        
                if (!$$errorR) {
                    Slinke::Messager->createObject(SLINKE     => $slinke,
                                                   NOINIT     => $noReset,
                                                   DEBUGLEVEL => $debugLevel,
                                                   MESSAGER   => \my $messager,
                                                   ERROR      => \my $error,
                                                   );
                    if ($error) {
                        $$errorR = "Unable to create " .
                            "Slinke::Messager object.  $error";
                    } else {
                        $$slinkeR = $slinke;
                        $$messagerR = $messager;
                    }
                }
            }
        }
    }
}



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

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

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

$activeDebugLevel = $cmdline{"debuglevel"} || 0;

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

my $file;
if (defined($cmdline{"database"})) {
    $file = $cmdline{"database"};
} else {
    $file = "slinke.irdb";
}

accessDatabase($file, $activeDebugLevel, \my $database);

accessSlinke($cmdline{"device"}, $cmdline{"noreset"}, 
             $activeDebugLevel, \my $slinke, \my $messager,
             \my $error);

if ($error) {
    die("Can't access the Slink-e.  $error");
}
my $term = new Term::ReadLine 'slinke';

# Term::ReadLine uses an underlying Readline engine, which is determined
# by the PERL_RL environment variable.  If it is unset, Term::ReadLine
# searches for one by certain names that is knows.  Typically, the 
# engine is Term::Readline::Gnu, and that is one of the names it searches
# for by default.  $term->ReadLine is the name of the engine in use.

my $historyFileName = historyFileName();

if (defined($historyFileName)) {
    $term->ReadHistory("$historyFileName") 
        or printf("Failed to read command history from '$historyFileName\n");
}

@playZones = $slinke->irZoneList();

commandLoop($slinke, $messager, $term, $database);

if ($database->dbStatus()->{MODIFIED}) {
    if (getYNFromUser("Save database modifications", "Y") eq "Y") {
        $database->writeDatabase();
    }
}

if (defined($historyFileName)) {
    $term->WriteHistory($historyFileName) 
        or die("Failed to write readline command history to $historyFileName");
}
