#!/usr/bin/perl

# Program to control a Nortek AS Paradopp product (specifically, a Vector
# unit, in my case).

# by Chris MacGregor (chris@bouncingdog.com)
# started July 2007, based on my stepit.pl program to control an Advanced
# Micro Systems SAX/DAX stepper motor controller (single axis).

$version = "0.3.9 8-19-07";
$versioninfo = "vectorControl.pl Version $version";

use Time::HiRes "usleep";
use Time::Local;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
use Errno;

# constants:

$acknak_len = 2;
$ack = "\x06";
$ackack = $ack x $acknak_len;
$nak = "\x15";
$naknak = $nak x $acknak_len;
$clock_data_bytes = 6;
$inquiry_response_bytes = 2;
$battery_voltage_bytes = 2;
$get_id_bytes = 14;

# variables (constants that can be overridden on the command line):

$commdev = "unknown";
@devices_to_try = ( "/dev/ttyUSB0", "/dev/ttyS0" );
foreach $dev (@devices_to_try)
{
    next if ! -e $dev;
    $commdev = $dev;
    last;
}
$breaktype = "soft";
$data_file = "vector_data.dat";
$bps = 9600;
# $bps = 115200;

$usage = <<ENDUSAGE;
$versioninfo
Control a Nortek AS Paradopp product (e.g., a Vector)

Usage:  vectorControl.pl [options] commandspec(s)

  Options:
    -verbose       Describe what vectorControl is doing
    -debug         Used for debugging vectorControl
    -commdev       Specify device to use for communications, or "none"
                   (default is $commdev)
    -bps BITRATE   Specify bit rate to use (e.g., 9600, 19200, 38400, 57600,
                   115200, etc.; default is $bps)
    -set_default_bps BITRATE
                   Send a command at the -bps bit rate to change to BITRATE,
                   and tell the device to make that the new default bit rate.
                   vectorControl will then exit, ignoring any further
                   commands.  For example, use:
                       -bps 19200 -set_default_bps 9600
                   if the device is currently operating at 19200 bps but you
                   want it to default to 9600 bps.
    -skipsleep[=N] Say how long we would have slept but really sleep only N
                   seconds (default 5) - useful (only) for testing/debugging
    -nowait        Don't wait for commands to complete - continue immediately
    -noexec        Don't actually execute any "exec" commands
    -notreally     Same as "-commdev none -skipsleep -noexec"; useful for
                   testing your vectorControl scripts

  Commandspec(s): any one or more of the following in any order:
    -do <command>
    <file_of_commands>
    -reset        (immediate version of "-do reset")
    -abort        (immediate version of "-do abort")
    -power_down   (immediate version of "-do power_down")
    -break        (immediate version of "-do break")

  ************  NOTE: following NOT WORKING IN THIS VERSION ************
  ************  NOTE: following NOT WORKING IN THIS VERSION ************

    1. Currently you can only specify the number of samples to collect;
       you can't specify an amount of time during which to collect
       data, and you can't specify an absolute time at which you wish
       to stop collecting data.
    2. There is no way to manage the data on the device (list it,
       download it, or delete it).
    3. There is no way to change the bit rate (aka baud rate) on the
       fly - only via the command line, and that assumes that the
       device is already operating at the selected bit rate.

  ************  NOTE: preceding NOT WORKING IN THIS VERSION ************
  ************  NOTE: preceding NOT WORKING IN THIS VERSION ************

  Command: any of the following:
    reset         Send a sequence that should get control no matter what
    abort         Send a sequence that should stop data collection and prepare
                  the device for further commands
    power_down    Tell the device to power down; use break to wake it up
    break         Send break
    flush         Discard any leftover input; implied by abort and reset
    command_mode  Tell the device to expect commands; should not normally be
                  needed, as it is implied by reset and abort (above)
    read_config TYPE FILE
                  where TYPE is one of: head hardware deployment all
                  Read the specified config info from the device and write it
                  to FILE
    configure FILE
                  Send the deployment config file FILE to the device.  This
                  should be a 512-byte *.pcf file (NOT a .dep file!) generated
                  by running 'Vector.exe -cu' and saving the deployment file.
    read_clock    Display the device's idea of the current date & time; note
                  that the date is shown in European format (day/month/year)
    set_clock     Set the device's idea of the current date & time to what the
                  PC thinks is the current date & time (you ARE using ntp,
                  aren't you?)
    battery_voltage
                  Show the current voltage of the internal battery, in
                  millivolts
    get_id        Show the device's identification of itself
    inquiry       Show the device's answer regarding its current state
    data_file FILE
                  Specify FILE as the file to which collected data (see
                  collect_data and record_data, below) should be appended.
                  If you want to erase any data already in the file, use
                  "exec rm FILE" first.

    collect_data TIME [TIME...]
    collect_data until ABSTIME
    collect_data NUM samples
    record_data  TIME [TIME...]
    record_data  until ABSTIME
    record_data  NUM samples
    record_data_quietly TIME [TIME...]
    record_data_quietly until ABSTIME
    record_data_quietly NUM samples
                  collect_data tells the device to send the data to the serial
                  port only (device command ST).  record_data (device command
                  SR) does the same but also records to the device's onboard
                  memory.  record_data_quietly (device command SD) records to
                  the device's onboard memory but does not output to the
                  serial port, and so no data is written to the data file.
                  In the collect_data and record_data commands, the data sent
                  to the serial port is stored in the data file (see data_file
                  command, above).
                  For each command, three forms are available: measuring until
                  a specified amount of time (e.g., 3 minutes) has passed;
                  measuring until an absolute time is reached; measuring for a
                  specified number of samples (which should be equivalent to
                  a specified amount of time, except that one or the other may
                  be more intuitive, depending on the situation).  See the
                  sleep command, below, for the syntax of the TIME and ABSTIME
                  parameters.

    sleep TIME [TIME...]
                  Sleep for TIME, where TIME is one or more of:
                      Wd    W days
                      Xh    X hours
                      Ym    Y minutes
                      Zs    Z seconds
                  ex. "sleep 20m" or "sleep 1h 37m 29s" or "sleep 7d"
    sleep until ABSTIME
                  Sleep until the specified absolute time, where ABSTIME is in
                  one of the following forms:
                      DD/MM/YYYY HH:MM:SS
                      DD/MM/YYYY HH:MM:SS am
                      DD/MM/YYYY HH:MM:SS pm
                      HH:MM:SS
                      HH:MM:SS am
                      HH:MM:SS pm
                  ex. "sleep until 14/06/2004 13:02:51"
                  or "sleep until 1:03 pm"
                  *** IMPORTANT NOTES: ***
                   * Dates are in the European format: day first followed by
                     month followed by year, NOT the US format (month first
                     followed by day).
                   * If no date is specified, then either the current or next
                     day is assumed, as follows: If the time specified has
                     already passed for the current day, then it is assumed to
                     refer to the next day; otherwise, the current day is
                     assumed.
                   * You may use a 24-hour clock (00:00 - 23:59) OR am/pm.
                     Specify a time like "14:02 pm" at your own risk.
    include FILE  Read and execute commands from FILE and then continue
    send CMD      Send literal CMD to the device directly with no
                  interpretation or modification
                  ex. "send PD"
    exec UNIXCMD  Execute literal UNIXCMD by passing it to the system shell
                  ex. "exec dvgrab -frames 100000000000000000000000001"
ENDUSAGE
    ; # this isn't syntactically necessary but it placates emacs' perl-mode

# !##########################################################################
# \fn void getargs (void)
# \brief Process command line arguments, setting various global variables
# (which are documented individually).
# !##########################################################################

sub getargs
{
    while (@ARGV)
    {
        $arg = shift @ARGV;
        if ($arg =~ /^-debug(w?)(\d*)$/)
        {
            # ! \var int $debug \brief is set to 1 or greater by -debug to
            # generate various forms and levels of debugging output.

            $debug += $2 || 1;
        }
        elsif ($arg =~ /^-v(?:erbose)?(\d*)$/)
        {
            # ! \var int $verbose \brief is set to 1 or greater by -verbose to
            # generate various forms and levels of information about what
            # the program is doing.

            $verbose += $1 || 1;
        }
        elsif ($arg =~ /^-comm(dev)?$/)
        {
            $commdev = shift @ARGV;
        }
        elsif ($arg =~ /^-bps$/)
        {
            $bps = shift @ARGV;
        }
        elsif ($arg =~ /^-do$/)
        {
            push (@cmds, shift @ARGV);
        }
        elsif ($arg =~ /^-set_default_bps$/)
	{
	    my $newbps = shift @ARGV;
	    set_default_bps ($newbps);
	    print "Exiting!\n";
	    exit 0;
	}
        elsif ($arg =~ /^-(reset|abort|break|power_down|command_mode|flush|inquiry)$/)
        {
            opencomm ();
            execute_command ($1);
            $didsomething = 1;
        }
        elsif ($arg =~ /^-skipsleep(?:=([\d\.]+))?$/)
        {
            $skipsleep = 1;  # only useful for debugging
            $sleepytime = $1 || 1;
        }
        elsif ($arg eq "-nowait")
        {
            $nowait = 1;
        }
        elsif ($arg eq "-noexec")
        {
            $noexec = 1;
        }
        elsif ($arg eq "-notreally" || $arg eq "-n")
        {
            $notreally = 1;
            $noexec = 1;
            $commdev = "none";
            $skipsleep = 1;
            $sleepytime = 5;
        }
        elsif ($arg !~ /^-/)
        {
            push (@cmds, "include $arg");
        }
        elsif ($arg =~ /^[-\/](\?|h(elp)?|usage)$/)
        {
            print $usage;
            exit 1;
        }
        else
        {
            print "$usage\nUnrecognized option \"$arg\"\n";
            exit 1;
        }
    }

    $verbose = 1
	if $debug && !$verbose;

    $| = 1
        if $verbose || 1;
}

#############################################################################
#############################################################################
#######################  General Utility Functions  #########################
#############################################################################
#############################################################################

# !##########################################################################
# \fn string getdate (void)
# \brief Return the current date and time, formatted like "Wed Feb 19 2003
# 12:40:09".
# !##########################################################################

sub getdate
{
    my ($when) = @_;
    $when = time
        if !defined ($when);
    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime ($when);
    my ($date) =
	sprintf ("%s %s %2d %d %02d:%02d:%02d",
		 ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat") [$wday],
		 ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
		  "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") [$mon],
		 $mday, $year + 1900, $hour, $min, $sec);
    return $date;
}

# !##########################################################################
# \fn string getshortdate (void)
# \brief Return the current date and time, formatted like " 5-Jul-2003 12:40:09".
# !##########################################################################

sub getshortdate
{
    my ($when) = @_;
    $when = time
        if !defined ($when);
    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime ($when);
    my ($date) =
	sprintf ("%2d-%s-%d %02d:%02d:%02d",
                 $mday, 
		 ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
		  "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") [$mon],
		 $year + 1900, $hour, $min, $sec);
    return $date;
}

# !##########################################################################
# \fn void opencomm (void)
# \brief Prepare for communications with the device, without sending anything
# yet.
# !##########################################################################

sub opencomm
{
    if ($commopen eq $commdev)
    {
	print "Comm on $commdev already open\n"
	    if $verbose >= 2 || $debug;
	return;
    }

    print "Initializing communications on $commdev at $bps bps...\n"
        if $verbose;

    if ($commdev eq "none")
    {
	print "DEBUG MODE: sending no data\n"; 
	return;
    }

    print "Opening $commdev...\n"
	if $verbose;

    my $sttycmd = "stty -F $commdev $bps -parenb cs8 cread clocal -crtscts " .
        "ignpar -parmrk -inpck -istrip -inlcr -igncr -icrnl -ixon -ixoff " .
        "-opost -ocrnl -onlcr -onocr -onlret -isig -icanon -iexten -echo " .
	"-echoe -echok -echoctl -echoke ignbrk -hupcl time 5";
    print "Running \"$sttycmd\"...\n"
	if $debug >= 2;
    system ($sttycmd);
    die "\"$sttycmd\" returned $?" if $?;

    open (COMM, "+< $commdev") || die "Can't open $commdev: $!";
    binmode (COMM, ":raw");

    $commopen = $commdev;
}

sub closecomm
{
    $commopen = undef;
    close (COMM);
}

# just send something

sub sendcmdnowait
{
    my ($cmd) = @_;

    print "Sending \"", escapestring ($cmd), "\"...\n"
        if $verbose >= 2 || ($verbose && length ($cmd) < 70);

    syswrite (COMM, "$cmd") || die "Write failed!!!";
}

sub setblocking
{
    my ($blocking) = @_;

    my $flags = fcntl (COMM, F_GETFL, 0)
        or die "Can’t get flags for $commdev: $!\n";

    if ($blocking)
    {
        $flags = $flags & ~O_NONBLOCK;
    }
    else
    {
        # inexplicably, '$flags |= O_NONBLOCK;' gets unrecognized character
        # \xE2. !?!?
        $flags = $flags | O_NONBLOCK;
    }

    $flags = fcntl (COMM, F_SETFL, $flags)
        or die "Can’t set flags for $commdev: $!\n";
}

sub escapestring
{
    my ($string) = @_;

    for (my $i = length ($string) - 1; $i >= 0; $i--)
    {
        my $char = ord (substr ($string, $i, 1));
        substr ($string, $i, 1) = sprintf ('\x%02x', $char)
            if $char < 32 || $char >= 127;
    }

    return $string;
}

sub dump_data
{
    my ($data) = @_;

    my $string;
    my $offset;
    while (length ($data))
    {
        my $chunk = substr ($data, 0, 16);
        $data = substr ($data, 16);
        $string .= sprintf ("0x%04x ", $offset);
        for (my $i = 0; $i < length ($chunk); $i++)
        {
            $string .= " "
                if $i == 8;
            $string .= sprintf (" %02x", ord (substr ($chunk, $i, 1)));
        }
        $string .= "\n";
        $offset += length ($chunk);
    }

    return $string;
}

sub flushinput
{
    my ($quietly) = @_;

    setblocking (0);

    my $string;

    while (1)
    {
        my $buffer;
        my $sysret = sysread (COMM, $buffer, 100000);
        die "sysread for flush: $! (" . int ($!) . ")"
            if !defined ($sysret) && ! $!{EAGAIN};
        last if length ($buffer) == 0;
        $string .= $buffer;
        $buffer = escapestring ($buffer);
        print "Discarding lost input: \"$buffer\"\n"
            if !$quietly;
    }

    setblocking (1);

    return $string;
}

# $res = check_acknak (acknak, force, msg)
# if msg is defined, will complain about NAK or unknown
# if force is defined, unknown forced to that with complaint
# else returns either "ACK", "NAK", or undef

sub check_acknak
{
    my ($acknak, $force, $msg) = @_;

    if ($acknak eq $ackack)
    {
        return "ACK";
    }

    if ($acknak eq $naknak)
    {
        print "$msg FAILED\n"
            if defined ($msg);
        return "NAK";
    }
    elsif (defined ($force))
    {
        printf ("$msg got neither ACK nor NAK: '%s' (calling it $force)\n",
                escapestring ($acknak));
        return $force;
    }

    return undef;
}

# send a command and wait for a response ending with ACK ACK or NAK NAK;
# return an array: [0] = any chars preceding the ACK ACK or NAK NAK, and
# [1] = "ACK" or "NAK" (NOT $ack or $nak).

sub sendcmd
{
    my ($cmd, $showresponse) = @_;

    sendcmdnowait ($cmd);

    return if $commdev eq "none";

    print "Waiting for ACK or NAK...\n"
        if $debug || $verbose >= 2;

    my $response;
    my $acknak;
    my $char;

    usleep (50 * 1000);
    $weird0reads = 0;

    while (length ($acknak) < $acknak_len)
    {
        my $sysret = sysread (COMM, $char, 1);
        if ($sysret < 1)
        {
            warn "sysread returned \"$sysret\": $! (" . int ($!) . ")";

            # All handling of this condition is a HACK!  (Because I don't
            # understand why this might happen...)

            setblocking (1);

            if (++$weird0reads > 20)
            {
                warn "resending command \"" . escapestring ($cmd) . "\"\n";
                flushinput();
                sendcmdnowait ($cmd);
            }
            else
            {
                sleep (1);
            }
            next;
        }
        else
        {
            $weird0reads = 0;
        }

	if ($debug >= 2)
	{
	    my $dchar = $char;
	    if ($dchar eq "\r")
	    {
		$dchar = "<\\r>";
	    }
	    elsif ($dchar eq "\n")
	    {
		$dchar = "<\\n>";
	    }
	    elsif (ord ($dchar) < 32)
	    {
		$dchar = sprintf ("<0x%02x>", ord ($dchar));
	    }

	    print "received \"$dchar\"\n";
	}

        if ($char eq $ack || $char eq $nak)
        {
            if (length ($acknak) > 0 && $acknak ne $char)
            {
                printf ("Uh oh, got 0x%02x followed by 0x%02x!?!  "
                        . "Treating as 0x%02x%02x\n",
                        ord ($acknak), ord ($char), ord ($char), ord ($char));
                $acknak = $char x $acknak_len;
            }
            else
            {
                $acknak .= $char;
            }
        }
        else
        {
            $response .= $char;
        }
    }

    my $validated = check_acknak ($acknak);
    if ($validated)
    {
        $acknak = $validated;
    }
    else
    {
        die "Internal botch: \$acknak neither ackack nor naknak: "
            . escapestring ($acknak);
    }

    my @response = ($response, $acknak);

    if ($showresponse || $verbose)
    {
        $response = escapestring ($response);
        print "Received: \"$response\" $acknak\n";
    }

    return @response;
}

sub read_data
{
    my ($len_wanted) = @_;

    my $data;

    print "read_data: want $len_wanted bytes\n"
        if $debug >= 1;

    while ($len_wanted > 0)
    {
        my $buffer;
        my $sysret = sysread (COMM, $buffer, $len_wanted);
        die "sysread for read_data: $! (" . int ($!) . ")"
            if !defined ($sysret) && ! $!{EAGAIN};
        $data .= $buffer;
        my $len = length ($buffer);
        die "sysread returned $sysret but data length = $len"
            if $len != $sysret;
        $len_wanted -= $len;
        print ("read_data: got $len bytes (", length ($data),
               " total), $len_wanted remaining\n")
            if $debug >= 1;
    }

    return $data;
}

sub sendinquiry
{
    my @response = sendcmd ("II");

    if ($response [1] eq "NAK")
    {
        print "inquiry NAK'd\n";
        return;
    }

    my $response = $response [0];
    warn "inquiry response length is " . length ($response)
        if length ($response) != $inquiry_response_bytes;
    $response = unpack ("v", $response);
    my $state = ("Firmware upgrade", "Measurement", "Command",
                 "Data retrieval", "Confirmation")[$response];
    $state = " ($state mode)"
        if $state ne "";
    printf ("Inquiry says mode is 0x%04x$state\n", $response);
}

sub sendbreak
{
    my ($times_called_already) = @_;

    my $breaksleep = 0.5;

    usleep ($breaksleep * 1000000);

    flushinput (!$verbose);

    if ($breaktype eq "hard")
    {
        die "hard break NYI - should set & hold break state for 500 ms";
    }
    elsif ($breaktype eq "soft")
    {
        sendcmdnowait ("@@@@@@");
        usleep (100 * 1000);
        sendcmdnowait ('K1W%!Q');
    }
    else
    {
        die "Unknown break type \"$breaktype\"";
    }

    usleep ($breaksleep * 2 * 1000000);

    # HERE: maybe we should wait for the "Confirm:" string (or the "Command
    # mode" string, in case we're not in measurement mode) BEFORE sending MC,
    # to avoid this:
    #
    # (collecting data)
    # 15-Jul-2007 15:51:52  Command: abort
    # Sending "@@@@@@"...
    # Sending "K1W%!Q"...
    # Break got neither ACK nor NAK: '' (calling it ???)
    # Break response is "" ???
    # Sending "MC"...
    # Received: "\x0a\x0dConfirm:" ACK
    # Sending "II"...
    # Received: "\x05\x00" ACK
    # Inquiry says mode is 0x0005
    # 15-Jul-2007 15:51:57  Command: power_down
    # Sending "PD"...
    # Received: "" NAK
    # 
    # But for now, we're increased the delay before we expect a response,
    # and we retry 9 more times if we didn't get one.

    my $response = flushinput (1); # flush quietly
    if (length ($response) == 0)
    {
        die "Sent $times_called_already Breaks with no response - "
            . "device is not responding!"
            if $times_called_already > 10;

        print (getshortdate(), "  No response from $commdev - ",
	       "re-sending break...\n");
        return sendbreak ($times_called_already + 1);
    }
    else
    {
        my $acknak = substr ($response, -$acknak_len);
        $acknak = check_acknak ($acknak, "???", "Break");
        $response = escapestring (substr ($response, 0, -$acknak_len));
        
        print "Break response is \"$response\" $acknak\n"
            if $showresponse || $verbose;
    }
}

my %timeconv = ( "d" => 60 * 60 * 24,
                 "h" => 60 * 60,
                 "m" => 60,
                 "s" => 1 );

sub fmttime
{
    my ($hour, $min, $sec) = @_;

    return sprintf ("%02d:%02d:%02d", $hour, $min, $sec);
}

sub convtime
{
    my (@parts) = @_;

    my $time = 0;

    if ($parts [0] eq "until")
    {
        my ($day, $month, $year, $hour, $minute, $second);
        shift @parts;
        foreach $part (@parts)
        {
            if ($part =~ /^(\d+)\/(\d+)\/(\d+)$/)
            {
                die "Syntax error in sleep until: \"$part\": date was already"
                    . " specified as $day/$month/$year\n"
                    if "$day$month$year" ne "";
                ($day, $month, $year) = ($1, $2, $3);
                if (length ($year) != 4)
                {
                    die "Syntax error in sleep until: \"$part\": year ($year)"
                        . " must be 4 digits\n";
                }
                if ($month > 12)
                {
                    die "Syntax error in sleep until: \"$part\": month ($month)"
                        . " must be 1-12 (maybe you meant to write "
                        . "\"$month/$day/$year\"?)\n";
                }
            }
            elsif ($part =~ /^(\d+):(\d\d)(?::(\d\d))?(am|pm)?$/i)
            {
                my ($newhour, $newminute, $newsecond, $ampm) = ($1, $2, $3, $4);
                die "Syntax error in sleep until: \"$part\": time was already"
                    . " specified as " . fmttime ($hour, $minute, $second) . "\n"
                    if "$hour$minute$second" ne "";
                $newsecond = "00"
                    if $newsecond eq "";
                ($hour, $minute, $second) = ($newhour, $newminute, $newsecond);
                push (@parts, $ampm)
                    if $ampm ne "";
            }
            elsif ($part =~ /^(am|pm)$/i)
            {
                if (lc $part eq "pm")
                {
                    if ($hour > 12)
                    {
                        warn "What do you mean by $hour:$minute:$second pm??\n";
                    }
                    elsif ($hour < 12)
                    {
                        $hour += 12;
                    }
                }
                else # am
                {
                    if ($hour > 12)
                    {
                        warn "What do you mean by $hour:$minute:$second am??\n";
                    }
                    elsif ($hour == 12)
                    {
                        $hour = 0;
                    }
                }
            }
            else
            {
                die "Syntax error in sleep until: \"$part\": not recognized "
                    . "as a date or time\n";
            }
        }
        die "Error in sleep until @parts: time not specified\n"
            if "$hour$minute$second" eq "";
        my ($nowsec, $nowmin, $nowhour, $nowmday, $nowmon, $nowyear)
            = localtime (time);
        my $boost = 0;
        if ($day eq "")
        {
            $boost = 24 * 60 * 60
                if (fmttime ($nowhour, $nowmin, $nowsec) >
                    fmttime ($hour, $minute, $second));
            ($day, $month, $year) = ($nowmday, $nowmon + 1, $nowyear + 1900);
        }
        my $abstime = timelocal ($second, $minute, $hour,
                                 $day, $month - 1, $year - 1900);

        my ($chksec, $chkmin, $chkhour, $chkmday, $chkmon, $chkyear)
            = localtime ($abstime);
        die "oops: ($chksec,$chkmin,$chkhour, $chkmday,$chkMon,$chkyear) " .
            "returned for ($second,$minute,$hour, $day,"
            . ($month-1) . "," . ($year - 1900) . ")\n"
            if ($chksec != $second || $chkhour != $hour ||
                $chkmin != $minute || $chkmon + 1 != $month ||
                $chkmday != $day || $chkyear + 1900 != $year);

        $abstime += $boost;
        $time = $abstime - time;
        if ($time < 0)
        {
            warn "*** You asked to sleep until "
                . getshortdate ($abstime) . ", but that time has already "
                . "passed;\n    it is currently " . getshortdate (time)
                . "!  Ignoring and continuing...\n";
            $time = 0;
        }
    }
    else
    {
        foreach $part (@parts)
        {
            if ($part =~ /^([\d\.]+)([dhms])$/)
            {
                $time += $1 * $timeconv {$2};
            }
            else
            {
                die "Syntax error in sleep: \"$part\": must be "
                    . "one or more of Xd, Xh, Xm, Xs where X is a number\n";
            }
        }

        if ($time <= 0)
        {
            warn "*** Did you really want to sleep for $time seconds?  "
                . "(I'm ignoring this!)\n";
            $time = 0;
        }
    }

    return $time;
}

sub check_packet
{
    my ($data, $magic, $name, $size) = @_;

    my $okay = 1;

    if (defined ($magic) && substr ($data, 0, length ($magic)) ne $magic)
    {
        my $badmagic = escapestring (substr ($data, 0, length ($magic)));
        $magic = escapestring ($magic);
        print "check_packet: $name: magic mismatch: exp. $magic, "
            . "got $badmagic\n";
        $okay = 0;
    }

    if ($size <= 0)
    {
        my $internalsize = 2 * unpack ("v", substr ($data, 2, 2));
        if ($size < 0)
        {
            $size = -$size;
            if ($internalsize != $size)
            {
                print "check_packet: $name: bad size: exp. $size, internal size = "
                    . "$internalsize\n";
                $okay = 0;
                $size = $internalsize;
            }
        }
        else
        {
            $size = $internalsize;
        }
    }

    if (length ($data) != $size)
    {
        print "check_packet: $name: bad size: exp. $size, got "
            . length ($data) . "\n";
        $okay = 0;
    }

    my $checksum = (unpack ("%16v*", substr ($data, 0, -2)) + 0xb58c) % 65536;
    my $expsum = unpack ("v", substr ($data, -2));
    if ($checksum != $expsum)
    {
        printf ("check_packet: %s: bad checksum: exp. 0x%04x, got 0x%04x\n",
                $name, $expsum, $checksum);
        $okay = 0;
    }

    print "$name packet okay\n"
        if $okay && $verbose;

    return $okay;
}

sub execute_command
{
    my ($cmd) = @_;

    my $cmd2 = $cmd;
    $cmd2 =~ s/\#.*$//;    # drop comments
    $cmd2 =~ s,\/\/.*$,,;  # drop comments
    $cmd2 =~ s/^\s+//;
    $cmd2 =~ s/\s+$//;
    next if $cmd2 eq "";

    my @parts = split (" ", $cmd2);

    print getshortdate(), "  Command: ", join (" ", @parts), "\n";
    my $keyword = shift @parts;
    if ($keyword eq "reset")
    {
        sendbreak();
        sendcmd ("MC");
        sleep (2);
        sendcmd ("MC");
        sleep (2);
        flushinput (!$verbose);
        sendinquiry();
        sendinquiry();
        sleep (2);
        flushinput (1);
    }
    elsif ($keyword eq "abort")
    {
        sendbreak();
        sendcmd ("MC");
        sleep (2);
        flushinput (!$verbose);
        sendinquiry();
        sleep (1);
        flushinput (!$verbose);
    }
    elsif ($keyword eq "break")
    {
        sendbreak();
    }
    elsif ($keyword eq "power_down")
    {
        sendcmd ("PD");
        usleep (500 * 1000);
    }
    elsif ($keyword eq "flush")
    {
        usleep (500 * 1000);
        flushinput();
    }
    elsif ($keyword eq "command_mode")
    {
        sendcmd ("MC");
        sleep (2);
    }
    elsif ($keyword eq "read_clock")
    {
        # We used to use sendcmd() here, but it gets confused if the clock
        # data happens to include a 15 or a 06 (e.g., at 6:xx am or July 15th
        # or ...).  Duh...
        # my @response = sendcmd ("RC");
        sendcmdnowait ("RC");
        my $response = read_data ($clock_data_bytes);
        my $acknak = check_acknak (read_data ($acknak_len), "???", $keyword);
        next if ($acknak ne "ACK");

        print ">", join ("< >", unpack ("H2" x 6, $response)), "<\n"
            if $debug >= 5;

        my ($min, $sec, $day, $hour, $year, $month)
            = unpack ("H2" x 6, $response);
        printf ("Device clock: %2d/%02d/%02d %2d:%02d:%02d\n",
                $day, $month, $year, $hour, $min, $sec);
    }
    elsif ($keyword eq "set_clock")
    {
        my ($sec, $min, $hour, $day, $month, $year) = localtime (time);

        my $clockdata = pack ("H*", sprintf ("%02d" x 6, $min, $sec + 1, $day,
                                             $hour, $year - 100, $month + 1));

        print ">", join ("< >", unpack ("H2" x 6, $clockdata)), "<\n"
            if $debug >= 5;

        ($min, $sec, $day, $hour, $year, $month)
            = unpack ("H2" x 6, $clockdata);
        printf ("Setting clock: %2d/%02d/%02d %2d:%02d:%02d\n",
                $day, $month, $year, $hour, $min, $sec)
            if $verbose;

        my @response = sendcmd ("SC" . $clockdata);
        if ($response [1] ne "ACK" || length ($response [0]) != 0)
        {
            print "$keyword failed.\n";
            next;
        }
    }
    elsif ($keyword eq "read_config")
    {
        my ($type, $outfile) = @parts;
        my %cfgtype = ( deployment => [ "GC", 512 ],
                        hardware   => [ "GP",  48 ],
                        head       => [ "GH", 224 ],
                        all        => [ "GA", 48 + 224 + 512 ] );
        if (!exists ($cfgtype {$type}))
        {
            die "Invalid $keyword type \"$type\": should be one of: "
                . join (" ", sort keys %cfgtype) . "\n";
        }
        my ($outcmd, $expsize) = @{$cfgtype {$type}};
        sendcmdnowait ($outcmd);
        my $data = read_data ($expsize);
        my $acknak = check_acknak (read_data ($acknak_len),
                                   "???", "$keyword $type");
        if ($acknak eq "ACK")
        {
            open (CFGOUT, "> $outfile")
                || die "Can't open $outfile for writing: $!\n";
            binmode (CFGOUT, ":raw");
            print CFGOUT $data;
            close (CFGOUT);
        }
    }
    elsif ($keyword eq "configure")
    {
        my $cfgfile = shift @parts;
        open (CFGIN, "< $cfgfile")
            || die "Can't open $cfgfile for reading: $!\n";
        binmode (CFGIN, ":raw");
        my $cfgdatalen = 512;
        my $cfgdata;
        my $len = sysread (CFGIN, $cfgdata, $cfgdatalen);
        die "Failed to read config data from $cfgfile (got $len): $!"
            if $len != $cfgdatalen;
        close (CFGIN);
        my @response = sendcmd ("CC" . $cfgdata);
        if ($response [1] ne "ACK")
        {
            print "$keyword failed.\n";
            next;
        }
    }
    elsif ($keyword eq "battery_voltage")
    {
        my @response = sendcmd ("BV");
        if ($response [1] ne "ACK" || length ($response [0])
            != $battery_voltage_bytes)
        {
            print "$keyword failed.\n";
            next;
        }

        my $response = unpack ("v", $response [0]);
        printf ("Current battery voltage is %d mV\n", $response);
    }
    elsif ($keyword eq "get_id")
    {
        my @response = sendcmd ("ID");
        if ($response [1] ne "ACK" || length ($response [0]) != $get_id_bytes)
        {
            print "$keyword failed.\n";
            next;
        }

        printf ("Device ID is \"%s\"\n", $response [0]);
    }
    elsif ($keyword eq "send")
    {
        my @response = sendcmd ($parts [0]);
        if ($response [1] ne "ACK")
        {
            print "$keyword @parts failed.\n";
            next;
        }

        printf ("Response to $parts[0] is \"%s\"\n", escapestring ($response [0]));
    }
    elsif ($keyword =~ /^(collect|record)_data(_quietly)?$/)
    {
        my ($record, $quietly) = ($1, $2);

        die "$cmd2 syntax is NYI (or invalid)"
            if (@parts != 2 || $parts [1] ne "samples"
                || $parts [0] !~ /^\d+$/);

        my $samplecount = $parts [0];
        die "sample count ($samplecount) should be at least one!"
            if $samplecount < 1;

        my $outcmd;
        if ($record eq "collect")
        {
            die "$keyword is not a valid command (did you mean collect_data "
                . "or record_data_quietly?)\n"
                if $quietly ne "";

            $outcmd = "ST"; # start, output to serial port, no recording
        }
        elsif ($quietly eq "")
        {
            $outcmd = "SR"; # start, output to serial port, and record
        }
        else
        {
            $outcmd = "SD"; # start, record only, no output
        }

        sendcmd ($outcmd);

        open (DATAOUT, ">> $data_file")
            || die "Can't open $data_file to append: $!";
        binmode (DATAOUT, ":raw");

        my $data;
        my $vector_system_data_magic = 0xa511;
        my $vector_system_data_size = 28;
        my $vector_velocity_data_header_magic = 0xa512;
        my $vector_velocity_data_header_size = 42;
        my $vector_velocity_data_magic = 0xa510;
        my $vector_velocity_data_size = 24;

        while ($samplecount > 0)
        {
            $data = read_data (4);
            my ($magic, $size) = unpack ("nv", $data);
            $size *= 2;
            if ($magic == $vector_velocity_data_magic)
            {
                $data .= read_data ($vector_velocity_data_size - 4);
                check_packet ($data, undef, "velocity data",
                              $vector_velocity_data_size);
                --$samplecount;
            }
            elsif ($magic == $vector_velocity_data_header_magic)
            {
                $data .= read_data ($size - 4);
                my ($min, $sec, $day, $hour, $year, $month)
                    = unpack ("H2" x 6, substr ($data, 4, 6));
                printf ("    @ %2d/%02d/%02d %2d:%02d:%02d  ",
                        $day, $month, $year, $hour, $min, $sec);
                check_packet ($data, undef, "velocity data header",
                              -$vector_velocity_data_header_size);
                my $nrecords = unpack ("v", substr ($data, 10, 2));
                print "nrecords = $nrecords\n";
            }
            elsif ($magic == $vector_system_data_magic)
            {
                $data .= read_data ($size - 4);
                check_packet ($data, undef, "vector system data",
                              -$vector_system_data_size);
            }
            else
            {
                printf ("Unknown packet type 0x%04x, size $size!!!\n", $magic);
                die if $size > 100;
                $data .= read_data ($size - 4);
            }

            print dump_data ($data)
                if $debug >= 20;

            print DATAOUT $data;
        }

        close (DATAOUT);
    }
    elsif ($keyword eq "inquiry")
    {
        sendinquiry();
    }
    elsif ($keyword eq "data_file")
    {
        $data_file = shift @parts;
        # HERE: syntax checking
        print "Data will be written to $data_file\n"
            if $verbose;
    }
    elsif ($keyword eq "include")
    {
        $filename = shift @parts;
        $linenum = 0;
        # HERE: syntax checking
        open (IN, "< $filename") || die "Can't open $filename: $!";
        my @morecmds = <IN>;
        close (IN);
        print "Reading commands from $filename...\n";
        unshift (@cmds, @morecmds, "endinclude");
    }
    elsif ($keyword eq "endinclude")
    {
        print "End of commands from $filename.\n";
        $filename = "";
        $linenum = 0;
        # HERE: syntax checking
    }
    elsif ($keyword eq "sleep")
    {
        my $time = convtime (@parts);
        my $howlong = "$time second";
        $howlong .= "s"
            if $time != 1;
        $howlong .= " (";
        if ($time > 60)
        {
            my $timeleft = $time;
            if ($timeleft > 60 * 60)
            {
                if ($timeleft > 60 * 60 * 24)
                {
                    my $days = int ($timeleft / (60 * 60 * 24));
                    $timeleft -= $days * 60 * 60 * 24;
                    $howlong .= "$days/";
                }
                my $hours = int ($timeleft / (60 * 60));
                $timeleft -= $hours * 60 * 60;
                $howlong .= "0"
                    if $hours < 10 && $howlong !~ /\($/;
                $howlong .= "$hours:";
            }
            my $minutes = int ($timeleft / 60);
            $timeleft -= $minutes * 60;
            $howlong .= "0"
                if $minutes < 10 && $howlong !~ /\($/;
            $howlong .= sprintf ("%d:%02d = ", $minutes, $timeleft);
        }
        $howlong .= "until " . getshortdate (time + $time) . ")";

        if ($skipsleep)
        {
            print "Would sleep for $howlong...";
            sleep ($sleepytime);
            print "and then continue.\n";
        }
        else
        {
            print "Sleeping for $howlong...\n";
            sleep ($time);
        }
    }
    elsif ($keyword eq "exec")
    {
        $cmd2 =~ s/^$keyword\s*//;
        if ($noexec)
        {
            print "Would execute \"$cmd2\"\n";
        }
        else
        {
            system ($cmd2);
            my $ret = $?;
            $ret /= 256
                if ($ret >= 0 && ($ret % 256) == 0);
            print "**** Command returned $ret!\n"
                if $ret;
        }
    }
    else
    {
        die "Command \"$keyword\" not recognized\n";
    }
}

sub set_default_bps
{
    my ($newbps) = @_;

    %bps_code =
	(
	    300 => "00",
	    600 => "11",
	   1200 => "22",
	   2400 => "33",
	   4800 => "44",
	   9600 => "55",
	  19200 => "66",
	  38400 => "77",
	  57600 => "88",
	 115200 => "99"
	);

    my $newbpscode = $bps_code {$newbps};
    die "Don't know how to set the device to $newbps bps!  Try one of these: "
	. join (" ", sort { $a <=> $b } keys %bps_code) . "\n"
	if $newbpscode eq "";

    opencomm ();

    print "\nPreparing to change from $bps bps to $newbps bps.\n"
	. "First, resetting device, just to be safe...\n\n";

    sendbreak();
    sendcmd ("MC");
    sleep (2);
    sendcmd ("MC");
    sleep (2);
    flushinput (!$verbose);
    sendinquiry();
    sendinquiry();
    sleep (2);
    flushinput (1);

    $verbose = 1
	if !$verbose;

    print "\nOkay, here we go...setting new bps rate ($newbps)...\n\n";
    my @response = sendcmd ("BR$newbpscode");
    die "FAILED to set new bps rate!"
	if $response [1] ne "ACK";

    print "\nNext, switching to $newbps bps on our end...\n\n";
    closecomm();
    $bps = $newbps;
    opencomm();

    print "\nNow, attempting to make $newbps the default...\n\n";
    my $tries_left = 3;
    while (--$tries_left >= 0)
    {
	@response = sendcmd ("SB3GA2");
	last if $response [1] eq "ACK";
	print "Hmmm, let's give that another shot...\n";
    }
    die "FAILED to set default bps rate!"
	if $tries_left < 0;

    print "\nWoo hoo!  It appears that we have successfully set the device's "
	. "default\nto $newbps bps!  Testing is recommended, of course...\n";
}

# main program starts here

getargs ();

if (@cmds == 0)
{
    exit 0 if $didsomething;
    die "$usage\nNeed something to do!\n";
}

print $versioninfo, "\n";

print "Running in -notreally (script testing) mode...\n"
    if $notreally;

opencomm ();

$linenum = 0;
$filename = "";
while (@cmds)
{
    $cmd = shift @cmds;
    $linenum++;
    execute_command ($cmd);
}

close (COMM);