#!/usr/bin/perl -wT
#
#       @(#)powerlinc 2004/10/16 Anne Bennett
# based on:
#       @(#)cp290 2004/09/21 Anne Bennett
# in turn based on der Mouse's 1995 C code "cmd-cp290.c"
#
# Talk to PowerLinc on serial port using Perl module.  At the
# moment, only the "standard" protocol is implemented, but hooks and a
# test pattern exist for the "extended" X10 protocol.
#
# usage: powerlinc [-d] [-v] <addrs> <cmds> [ <addrs> <cmds> ... ]
#        powerlinc [ help | listen | test ]

# -------------------------------------------------------------------
#
# Copyright (c) 2004 Anne Bennett.  All rights reserved.
#
# Redistribution and use, with or without modification, are permitted
# provided that the following conditions are met:
#   1. Redistributions must retain the above copyright notice, this
#      list of conditions and the following disclaimer.
#   2. The name of the author(s) may not be used to endorse or promote
#      products derived from this software without specific prior 
#      written permission.
#
#   THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED
#   WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
#   OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
#   DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
#   LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
#   OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 
#   PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
#   OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
#   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
#   OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#   OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
#   POSSIBILITY OF SUCH DAMAGE.
#
# -------------------------------------------------------------------


# The protocol to talk to the PowerLinc is described in the "PowerLinc
# Programming Manual" at
#   http://www.smarthome.com/manuals/1132B_Programming.pdf
#
# Paraphrased summary: 
#
# The PowerLinc uses the computer's serial port, with settings of 9600bps,
# 8 data bits, 1 stop bit, no parity.  It can send most of the standard
# X10 function codes with a special shorthand command set, or any of the
# standard or extended X10 codes (or any bits at all) by raw data
# transmission.  It also listens on the line and reports X10 codes
# (standard or extended) that it sees.
# 
# Before any command, send 0x02, and wait for ACK (0x06,0x0D) or NAK (0x15).
# Specific details of commands and responses are described below, in the
# subroutines that implement the commands.
#
#
# The "bits on the wire" protocol for standard and extended X10 is
# described in:
# http://www.geocities.com/ido_bartana/standard_and_extended_x10_code_format.htm

# Since not all commands can be sent with the shorthand code, but all
# of them (standard and extended) can be sent by raw data transmission,
# this implementation uses the raw data form in all cases.  After an
# initial syntax-level parsing, addr+cmd arguments are processed in a
# state machine:
#
# initial state:                read an arg, then:
#    address            stack it, go to address collection state
#    command            error: no addresses supplied
#    end                (end)
# address collection state:     read an arg, then:
#    address            stack it, stay in address collection state
#    command            stack it, go to command collection state
#    end                error: no command supplied
# command collection state:     read an arg, then:
#    address            PUSH IT BACK, go to command issuing state
#    command            stack it, stay in command collection state
#    end                go to command issuing state
# command issuing state:        issue pending commands to addresses,
#                               then clear all and go to initial state


use strict;

use Device::SerialPort;

$ENV{'PATH'} = "/bin";
$ENV{'IFS'}  = " \t\n";

# ---------------------- configuration -------------------------------

my ( $obj, $port, $baud, $data, $parity, $stop, $hshake, $dtype );
$port   = '/dev/tty00';
$baud   = 9600;
$data   = 8;
$parity = "none";
$stop   = 1;
$hshake = "none";
$dtype  = "raw";

# ---------------------- global variables ----------------------------

my $ready      = 0; # Set when serial port has been initialized
my $verbose    = 0; # Verbose output,   set on cmdline with -v
my $debug      = 0; # Debugging output, set on cmdline with -d
my $quiet      = 0; # Quiet (no output except errors), set with -q

  # The below is an array of hashrefs, where each hash contains:
  #   type = "address" or "command"
  # if address:
  #   housecode = valid capital letter housecode
  #   unitcode  = valid numeric unit code
  # if command:
  #   command = valid lowercase command name
  #   level   = in case of ddim only, valid numeric level
my @PARSED_ARGS = ();
  # The three variables below track progress through the state machine:
my %addresses;  # keys = housecodes, values = hashrefs to unitcode lists
my @commands;   # command hashrefs as per @PARSED_ARGS above
my $curstate;   # current state in machine
my $oldstate;   # previous state in machine

# ---------------------- constants -----------------------------------

my $progname       = "powerlinc";
my $subname        = "main";
my $MAXREPLY       = 2048; # maximum length of reply (bytes) from CP290
my $UNKNOWN        = -2;   # placeholder for unknown number of bytes
my $STD_RESP_LEN   = 5;    # numbytes of response for std X10 command
my $ACK_RESP_LEN   = 2;    # numbytes of response for "powerlinc ready?"
my $MAX_TRY_START  = 5;    # maximum attempts to get "ready" from device
my $SLEEP_TRY      = 0.5;  # seconds to sleep between tries to get "ready"
my $SLEEP_LOOP     = 2;    # seconds to sleep in "listen" loop
my $START_CMD      = 0x02;
my $ACK            = 0x06;
my $NAK            = 0x15;
my $RCVD_STD       = 0x58;
my $RCVD_STD_UNDOC = 0x78;
my $RCVD_EXT       = 0x65;
my $RCVD_EXT_UNDOC = 0x45;
my $EOT            = 0x0d;
my $SEND_X10       = 0x63;
my $SEND_EXT       = 0x80;
my $REPEATS        = 1;
my $START_CODE     = 0x0e;
my $END_CODE       = 0x00;
my $bitstring_fmt  = "%10d  %22s    ";

my %hc_letter_to_x10 = (
  'A' => 0x06,
  'B' => 0x0e,
  'C' => 0x02,
  'D' => 0x0a,
  'E' => 0x01,
  'F' => 0x09,
  'G' => 0x05,
  'H' => 0x0d,
  'I' => 0x07,
  'J' => 0x0f,
  'K' => 0x03,
  'L' => 0x0b,
  'M' => 0x00,
  'N' => 0x08,
  'O' => 0x04,
  'P' => 0x0c,
);
my %hc_x10_to_letter = (
  0x06 => 'A',
  0x0e => 'B',
  0x02 => 'C',
  0x0a => 'D',
  0x01 => 'E',
  0x09 => 'F',
  0x05 => 'G',
  0x0d => 'H',
  0x07 => 'I',
  0x0f => 'J',
  0x03 => 'K',
  0x0b => 'L',
  0x00 => 'M',
  0x08 => 'N',
  0x04 => 'O',
  0x0c => 'P',
);

my %units_num_to_x10 = (
    1 => 0x06,
    2 => 0x0e,
    3 => 0x02,
    4 => 0x0a,
    5 => 0x01,
    6 => 0x09,
    7 => 0x05,
    8 => 0x0d,
    9 => 0x07,
   10 => 0x0f,
   11 => 0x03,
   12 => 0x0b,
   13 => 0x00,
   14 => 0x08,
   15 => 0x04,
   16 => 0x0c,
);
my %units_x10_to_num = (
  0x06 => 1,
  0x0e => 2,
  0x02 => 3,
  0x0a => 4,
  0x01 => 5,
  0x09 => 6,
  0x05 => 7,
  0x0d => 8,
  0x07 => 9,
  0x0f => 10,
  0x03 => 11,
  0x0b => 12,
  0x00 => 13,
  0x08 => 14,
  0x04 => 15,
  0x0c => 16,
);

# Levels 0 - 31, mappings to command and "housecode/level" encodings:
my %ddim_levels_to_cmds = (
   0 =>  [ "ddim-high", 0x00 ], # aka hc=M   "Preset Dim 0%"
   1 =>  [ "ddim-high", 0x08 ], # aka hc=N   "Preset Dim 3%"
   2 =>  [ "ddim-high", 0x04 ], # aka hc=O   "Preset Dim 6%"
   3 =>  [ "ddim-high", 0x0c ], # aka hc=P   "Preset Dim 10%"
   4 =>  [ "ddim-high", 0x02 ], # aka hc=C   "Preset Dim 13%"
   5 =>  [ "ddim-high", 0x0a ], # aka hc=D   "Preset Dim 16%"
   6 =>  [ "ddim-high", 0x06 ], # aka hc=A   "Preset Dim 19%"
   7 =>  [ "ddim-high", 0x0e ], # aka hc=B   "Preset Dim 23%"
   8 =>  [ "ddim-high", 0x01 ], # aka hc=E   "Preset Dim 26%"
   9 =>  [ "ddim-high", 0x09 ], # aka hc=F   "Preset Dim 29%"
  10 =>  [ "ddim-high", 0x05 ], # aka hc=G   "Preset Dim 32%"
  11 =>  [ "ddim-high", 0x0d ], # aka hc=H   "Preset Dim 35%"
  12 =>  [ "ddim-high", 0x03 ], # aka hc=K   "Preset Dim 38%"
  13 =>  [ "ddim-high", 0x0b ], # aka hc=L   "Preset Dim 42%"
  14 =>  [ "ddim-high", 0x07 ], # aka hc=I   "Preset Dim 45%"
  15 =>  [ "ddim-high", 0x0f ], # aka hc=J   "Preset Dim 48%"
  16 =>  [ "ddim-low",  0x00 ], # aka hc=M   "Preset Dim 52%"
  17 =>  [ "ddim-low",  0x08 ], # aka hc=N   "Preset Dim 55%"
  18 =>  [ "ddim-low",  0x04 ], # aka hc=O   "Preset Dim 58%"
  19 =>  [ "ddim-low",  0x0c ], # aka hc=P   "Preset Dim 61%"
  20 =>  [ "ddim-low",  0x02 ], # aka hc=C   "Preset Dim 65%"
  21 =>  [ "ddim-low",  0x0a ], # aka hc=D   "Preset Dim 68%"
  22 =>  [ "ddim-low",  0x06 ], # aka hc=A   "Preset Dim 71%"
  23 =>  [ "ddim-low",  0x0e ], # aka hc=B   "Preset Dim 74%"
  24 =>  [ "ddim-low",  0x01 ], # aka hc=E   "Preset Dim 77%"
  25 =>  [ "ddim-low",  0x09 ], # aka hc=F   "Preset Dim 81%"
  26 =>  [ "ddim-low",  0x05 ], # aka hc=G   "Preset Dim 84%"
  27 =>  [ "ddim-low",  0x0d ], # aka hc=H   "Preset Dim 87%"
  28 =>  [ "ddim-low",  0x03 ], # aka hc=K   "Preset Dim 90%"
  29 =>  [ "ddim-low",  0x0b ], # aka hc=L   "Preset Dim 94%"
  30 =>  [ "ddim-low",  0x07 ], # aka hc=I   "Preset Dim 97%"
  31 =>  [ "ddim-low",  0x0f ], # aka hc=J   "Preset Dim 100%"
);
my %ddim_cmds_to_levels = (
  "ddim-high-0x00" =>  0, # aka hc=M   "Preset Dim 0%"
  "ddim-high-0x08" =>  1, # aka hc=N   "Preset Dim 3%"
  "ddim-high-0x04" =>  2, # aka hc=O   "Preset Dim 6%"
  "ddim-high-0x0c" =>  3, # aka hc=P   "Preset Dim 10%"
  "ddim-high-0x02" =>  4, # aka hc=C   "Preset Dim 13%"
  "ddim-high-0x0a" =>  5, # aka hc=D   "Preset Dim 16%"
  "ddim-high-0x06" =>  6, # aka hc=A   "Preset Dim 19%"
  "ddim-high-0x0e" =>  7, # aka hc=B   "Preset Dim 23%"
  "ddim-high-0x01" =>  8, # aka hc=E   "Preset Dim 26%"
  "ddim-high-0x09" =>  9, # aka hc=F   "Preset Dim 29%"
  "ddim-high-0x05" => 10, # aka hc=G   "Preset Dim 32%"
  "ddim-high-0x0d" => 11, # aka hc=H   "Preset Dim 35%"
  "ddim-high-0x03" => 12, # aka hc=K   "Preset Dim 38%"
  "ddim-high-0x0b" => 13, # aka hc=L   "Preset Dim 42%"
  "ddim-high-0x07" => 14, # aka hc=I   "Preset Dim 45%"
  "ddim-high-0x0f" => 15, # aka hc=J   "Preset Dim 48%"
  "ddim-low-0x00"  => 16, # aka hc=M   "Preset Dim 52%"
  "ddim-low-0x08"  => 17, # aka hc=N   "Preset Dim 55%"
  "ddim-low-0x04"  => 18, # aka hc=O   "Preset Dim 58%"
  "ddim-low-0x0c"  => 19, # aka hc=P   "Preset Dim 61%"
  "ddim-low-0x02"  => 20, # aka hc=C   "Preset Dim 65%"
  "ddim-low-0x0a"  => 21, # aka hc=D   "Preset Dim 68%"
  "ddim-low-0x06"  => 22, # aka hc=A   "Preset Dim 71%"
  "ddim-low-0x0e"  => 23, # aka hc=B   "Preset Dim 74%"
  "ddim-low-0x01"  => 24, # aka hc=E   "Preset Dim 77%"
  "ddim-low-0x09"  => 25, # aka hc=F   "Preset Dim 81%"
  "ddim-low-0x05"  => 26, # aka hc=G   "Preset Dim 84%"
  "ddim-low-0x0d"  => 27, # aka hc=H   "Preset Dim 87%"
  "ddim-low-0x03"  => 28, # aka hc=K   "Preset Dim 90%"
  "ddim-low-0x0b"  => 29, # aka hc=L   "Preset Dim 94%"
  "ddim-low-0x07"  => 30, # aka hc=I   "Preset Dim 97%"
  "ddim-low-0x0f"  => 31, # aka hc=J   "Preset Dim 100%"
);

my %func_x10_to_str = (
  0x00 => "all units off",
  0x01 => "all lights on",
  0x02 => "on",
  0x03 => "off",
  0x04 => "dim",
  0x05 => "bright",
  0x06 => "all lights off",
  0x07 => "ext1 (data/ctrl)",
  0x08 => "hail request",
  0x09 => "MISSING",
  0x0a => "ddim-high",          # aka ext3 (security)
  0x0b => "ddim-low",           # aka UNUSED
  0x0c => "ext2 (meter/dsm)",
  0x0d => "status=on",
  0x0e => "status=off",
  0x0f => "statreq",
);
my %func_str_to_x10 = (
  "all units off"       => 0x00,
  "all lights on"       => 0x01,
  "on"                  => 0x02,
  "off"                 => 0x03,
  "dim"                 => 0x04,
  "bright"              => 0x05,
  "all lights off"      => 0x06,
  "ext1 (data/ctrl)"    => 0x07,
  "extended"            => 0x07,
  "hail request"        => 0x08,
  "hail ack"            => 0x09,
  "ext3 (security)"     => 0x0a,
  "ddim-high"           => 0x0a,
  "UNUSED"              => 0x0b,
  "ddim"                => 0x0b, # for use by "is_standard_x10_command" only
  "ddim-low"            => 0x0b,
  "ext2 (meter/dsm)"    => 0x0c,
  "status=on"           => 0x0d,
  "status=off"          => 0x0e,
  "statreq"             => 0x0f,
);

my %expects_answer = (
  "hail request"   => 1,
  "status request" => 1,
  "statreq"        => 1,
  "ext_statreq"    => 1,
);


# ---------------------- serial communications subroutines -----------

sub show_serial_port_settings()
{
  my $baud   = $obj->baudrate;
  my $parity = $obj->parity;
  my $data   = $obj->databits;
  my $stop   = $obj->stopbits;
  my $hshake = $obj->handshake;
  my $dtype  = $obj->datatype;
  my @arr    = ();

  push @arr,
    sprintf("B=$baud, D=$data, S=$stop, P=$parity, H=$hshake, T=$dtype"),
    sprintf("_CFLAG   = %s", $obj->{"_CFLAG"}  ? $obj->{"_CFLAG"}  : "UNDEF"),
    sprintf( "_IFLAG  = %s", $obj->{"_IFLAG"}  ? $obj->{"_IFLAG"}  : "UNDEF"),
    sprintf( "_ISPEED = %s", $obj->{"_ISPEED"} ? $obj->{"_ISPEED"} : "UNDEF"),
    sprintf( "_LFLAG  = %s", $obj->{"_LFLAG"}  ? $obj->{"_LFLAG"}  : "UNDEF"),
    sprintf( "_OFLAG  = %s", $obj->{"_OFLAG"}  ? $obj->{"_OFLAG"}  : "UNDEF"),
    sprintf( "_OSPEED = %s", $obj->{"_OSPEED"} ? $obj->{"_OSPEED"} : "UNDEF"),
    sprintf( "NAME    = %s", $obj->{"NAME"}    ? $obj->{"NAME"}    : "UNDEF");
  return @arr;
}


sub set_up_serial_port()
{
  my $subname = "set_up_serial_port";
  $obj = Device::SerialPort->new ($port);
  die "Can't open serial port $port: $!\n" unless ($obj);

  $obj->baudrate($baud)       || die "fail setting baud";
  $obj->parity($parity)       || die "fail setting parity";
  $obj->databits($data)       || die "fail setting databits";
  $obj->stopbits($stop)       || die "fail setting stopbits";
  $obj->handshake($hshake)    || die "fail setting handshake";
  $obj->datatype($dtype)      || die "fail setting datatype";
  $obj->read_const_time(1000) || die "fail setting read_const_time";
  $obj->read_char_time(5)     || die "fail setting read_char_time";
  $obj->write_settings        || die "no settings";

  $ready = 1;
  debug($subname, show_serial_port_settings());
}


sub clean_up_serial_port()
{
  return unless $ready;
  $obj->close()
    or die "Error closing serial port $port: $!\n";
}


# ---------------------- reporting subroutines -----------------------

sub usage
{
  # print the error message, if any.
  foreach ( @_ )
  {
    my $line = $_;
    chomp $line;
    print(STDERR "$progname: $line\n");
  }
  # then print the usage message and exit
  printf(STDERR 
         "usage: %s [-d] [-v] <addrs> <cmds> [ <addrs> <cmds> ...]\n"
        ."       %s [ help | listen | test | prog=<metacmd> ]\n",
         $progname, $progname);
  clean_up_serial_port();
  exit(1);
}

sub long_usage()
{
  # print the help message and exit
  printf(STDERR 
         "usage: %s [-d] [-v] <addrs> <cmds> [ <addrs> <cmds> ...]\n"
        ."       %s [ help | listen | test | prog=<metacmd> ]\n",
         $progname, $progname);
  printf(STDERR "
    -d  turn on debugging output
    -v  turn on verbose output
    -q  quiet, turn off all non-error output
    <addrs>   is <addr> [ <addr> ... ]
    <cmds>    is <cmd>  [ <cmd>  ... ]
    <addr>    is Hn or Hn,p,q...  where H is a housecode A-P
                                  and n,p,q are unit codes 1-16
    <cmd>     is [ on off bright dim statreq ddim=n ]
                                  where n is percent brightness 0-100
    prog=<metacmd>
        issue command sequence for module programming, where 
        <metacmd> is [ clear setramp defonlevel addscene delscene rampscene ]
    test
        issue hardcoded test pattern (for debugging only)
    listen
        loop listening on serial port and report traffic seen
    help
        show this message
    EXAMPLE:
        $progname e7,8 on e7 dim dim dim
");
  exit(0);
}


# for reporting errors
sub printerr
{
  my $subname = shift @_;
  $subname = "UNKNOWN_SUB" unless $subname;
  # print the error, if any.
  foreach ( @_ )
  {
    my $line = $_;
    chomp $line;
    print(STDERR "$progname: $subname: ERROR: $line\n");
  }
}


# for reporting warnings
sub printwarn
{
  my $subname = shift @_;
  $subname = "UNKNOWN_SUB" unless $subname;
  # print the warnings, if any.
  foreach ( @_ )
  {
    my $line = $_;
    chomp $line;
    print(STDERR "$progname: $subname: WARNING: $line\n");
  }
}


# for other reports
sub printreport
{
  my $subname = shift @_;
  $subname = "UNKNOWN_SUB" unless $subname;
  # print the report, if any.
  foreach ( @_ )
  {
    my $line = $_;
    chomp $line;
    print("$progname: $subname: $line\n");
  }
}


# for debugging info
sub debug
{
  return unless $debug;
  my $subname = shift @_;
  $subname = "UNKNOWN_SUB" unless $subname;
  # print the debug messages, if any.
  foreach ( @_ )
  {
    my $line = $_;
    chomp $line;
    print(STDERR sprintf("$progname: DEBUG: %-30s: $line\n",$subname));
  }
}


# for "verbose" info
sub verbose
{
  return unless ( $verbose or $debug );
  # print the debug messages, if any.
  foreach ( @_ )
  {
    my $line = $_;
    chomp $line;
    print(STDERR "$progname: $line\n");
  }
}


# return a human-readable bit string given a byte
sub showbits($)
{
  my ( $hex ) = @_;
  my ( $string, $bit );
  $string = "";
  $bit = 0x80;
  while ( $bit > 0 )
  {
    $string .= sprintf("%d ",($hex & $bit) ? 1 : 0 );
    $bit >>= 1;
  }
  $string .= "(0x".uc(sprintf("%02x)", $hex));
  return($string);
}


# return a string listing the addresses in the current list
sub show_current_addresses()
{
  my ( $string, $housecode, $unitcode );
  $string = "";
  foreach $housecode ( sort keys %addresses )
  {
    foreach $unitcode ( sort keys %{$addresses{$housecode}} )
    {
      $string .= ", $housecode$unitcode";
    }
  }
  $string =~ s/^, //;
  return $string;
}


# return a string listing the commands in the current list
sub show_current_commands()
{
  my ( $string, $item, $command, $level );
  $string = "";
  foreach $item ( @commands )
  {
    $string .= sprintf(", %s", $item->{"command"});
    if ( defined($item->{"level"}) )
    {
      $string .= sprintf("=%d", $item->{"level"});
    }
  }
  $string =~ s/^, //;
  return $string;
}


# ---------------------- conversion subroutines ----------------------

# Return an array of ones and zeroes corresponding to the least
# significant "numbits" bits of the given number.
sub number_to_bits($$)
{
  my ( $numbits, $number ) = @_;
  my ( @array, $bitmask );
  @array = ();
  $bitmask = 1 <<($numbits-1);
  while ( $bitmask > 0 )
  {
    push @array, ($number & $bitmask) ? 1 : 0 ;
    $bitmask >>= 1;
  }
  return(@array);
}


# Given an array of ones and zeroes, returns an array where each bit
# is followed by its complement, e.g. ( 0, 1 ) => ( 0,1, 1,0 )
sub bit_complements
{
  my ( @bits_out, $bit );
  my $subname = "bit_complements";

  @bits_out = ();
  foreach $bit ( @_ )
  {
    if    ( $bit == 0 )
    {
      push @bits_out, 0, 1;
    }
    elsif ( $bit == 1 )
    {
      push @bits_out, 1, 0;
    }
    else
    {
      die "INTERNAL ERROR in $subname: invalid bit '$bit'";
    }
  }
  return @bits_out;
}


# ---------------------- other utility subroutines -------------------

# Arg: the number of bytes expected in the reply; if $UNKNOWN, then any
#      positive number is OK.
# Get a reply from the Powerlinc.  Return a string ("ok" or "err reason"),
# then an array of bytes if possible.
sub getreply($)
{
  my ( $expected_bytes ) = @_;
  my ( $replylen, $replystring, @reply, $packformat, $i );

  return ("ok", ()) if $expected_bytes == 0;
  # Get bytes from the device and unpack them:
  if ( $expected_bytes == $UNKNOWN )
  {
    ( $replylen, $replystring ) = $obj->read($MAXREPLY);
  }
  else
  {
    ( $replylen, $replystring ) = $obj->read($expected_bytes);
  }
  $packformat = "C".$replylen;
  @reply = unpack $packformat, $replystring;

  # show bits of bytes we received, and interpretation
  if ( $verbose ) # show bits of bytes we received
  { 
    verbose(sprintf("<<< %d bytes", $replylen))
  }
  # interpret the bytes:
  parsereply(@reply);

  # Check for ridiculously long replies:
  return ("err reply too long, $replylen >= $MAXREPLY", @reply)
    if ( $replylen >= $MAXREPLY );

  # Check for empty replies:
  return ("err reply too short (0)", @reply)
    if ( $replylen <= 0 );

  # Check for wrong number of bytes, if expected bytes known:
  unless ( $expected_bytes == $UNKNOWN )
  {
    return ("err reply has wrong number of bytes, expected $expected_bytes, "
           ."got $replylen", @reply)
      unless ( $expected_bytes == $replylen );
  }


  # All tests pass, so far!
  return ("ok", @reply);
}


# Returns true (device is ready) or false (device not ready)
sub start_command()
{
  my $subname = "start_command";
  my ( $status, @bytes, $try );

  # The first command we issue needs to have the serial port set up:
  set_up_serial_port() unless $ready;

  foreach $try ( 1 .. $MAX_TRY_START )
  {
    # Send the "start command" byte:
    $obj->write(pack("C", $START_CMD));

    # show the bits for each byte we wrote:
    {
      # Report total number of bytes:
      verbose(">>> 1 byte");
      # show bits for bytes sent
      {
        verbose(sprintf($bitstring_fmt, 1, showbits($START_CMD))."Ready?");
      }
    }

    # Check the response:
    ($status, @bytes) = getreply($ACK_RESP_LEN);

    # Check for NAK before checking status, as the response will have
    # "wrong number of bytes" if it's a NAK
    if ( ( scalar(@bytes) == 1 ) && ( $bytes[0] == $NAK ) )
    {
      debug($subname, "not ready on try # $try");
      select(undef, undef, undef, $SLEEP_TRY); 
      next;
      printerr($subname, "device not ready");
      return undef;
    }

    # OK, now check the response in the normal way:
    print_status_if_error($subname, $status);
    if ( $status ne "ok" )
    {
      return undef;
    }

    if ( ( scalar(@bytes) == 2 ) &&
         ( $bytes[0] == $ACK ) && ( $bytes[1] == $EOT ) )
    {
      return 1; # ready!
    }
    else
    {
      printerr($subname, "unknown reply to command ready");
      return undef;
    }
  } # foreach $try

  # Still here?  The device wasn't ready!
  printerr($subname, 
           sprintf("device not ready after %d tries %d seconds apart"),
                   $MAX_TRY_START, $SLEEP_TRY);
  return undef;
}


# Send a command to the Powerlinc.
# Args: bytes to send.
sub send_to_powerlinc
{
  my ( @bytes ) = @_;
  my $subname = 'send_to_powerlinc';

  # Make sure that the device is ready to accept a command:
  unless ( start_command() )
  {
    printerr($subname, "aborting because device not ready");
    return;
  }

  # Write out the byte stream to the device:
  {
    # just pack up all the bytes
    my $packformat = "C".(scalar(@bytes));
    my $packed_value = pack $packformat, @bytes;
    $obj->write($packed_value);
  }

  if ($verbose) # show the bits for each byte we wrote:
  {
    my ( $i, $numbytes );
    $numbytes = scalar(@bytes);
    # Report total number of bytes:
    verbose(sprintf(">>> %d bytes", $numbytes));
    # show bits for bytes sent
    foreach $i ( 0 .. $numbytes-1 )
    {
      my $more = "";
      if ( $i == 0 )
      {
        if    ( $bytes[$i] == $SEND_X10 )
        {
          $more = "Send std x10";
        }
        elsif ( $bytes[$i] == $SEND_EXT )
        {
          $more = "Send ext x10";
        }
      }
      if ( ( $i == 1 ) && ( $bytes[0] == $SEND_EXT ) )
      {
        $more = sprintf("bytecount=%d",scalar(@bytes)-2);
      }
      if ( ( $i > 1 ) && ( $bytes[0] == $SEND_EXT ) )
      {
        $more = "literal bits";
      }
      verbose(sprintf($bitstring_fmt,, $i+1, showbits($bytes[$i])).$more);
    }
  }
}

# Turn the bit stream into a byte stream:
sub bits_to_bytes
{
  my ( @bits ) = @_;
  my $subname = "bits_to_bytes";
  my ( $byte, @bytes );

  debug($subname, sprintf("got %d bits (%.2f bytes)",scalar(@bits),
                                                    (scalar(@bits)/8)));
  until ( ( scalar(@bits) % 8 ) == 0 ) # need an integral number of bytes
  {
    push @bits, 0;
  }
  debug($subname, sprintf("corrected to %d bits (%.2f bytes)",scalar(@bits),
                                                            (scalar(@bits)/8)));
  @bytes = ();
  while ( @bits )
  {
    $byte = 0;
    foreach ( 1 .. 8 )
    {
      $byte = $byte<<1 | ( shift @bits );
    }
    push @bytes, $byte;
  }
  debug($subname, 
        "calculated bytes: ".join(", ",map(sprintf("0x%x",$_),@bytes)));
  return(@bytes);
}

sub send_rawdata
{
  my ( @bits ) = @_;
  my $subname = 'send_rawdata';
  my ( @bytes );

  @bytes = bits_to_bytes(@bits);
  send_to_powerlinc($SEND_EXT, scalar(@bytes), @bytes);
}

# ------ Interpreting replies from the powerlinc:
#
# Here's what was reported when I hit "e8 on" on a controller:
#  1  0 1 1 1 1 0 0 0 (0x78)  "seen on the wire"
#  2  0 1 0 0 0 0 0 1 (0x41)  housecode E (as "powerlinc code")
#  3  0 1 0 1 1 0 1 0 (0x5A)  unit 8 (as "powerlinc code")
#  4  0 0 1 1 0 0 0 1 (0x31)  once
#  5  0 0 0 0 1 1 0 1 (0x0D)  eot
#  6  0 1 1 1 1 0 0 0 (0x78)  "seen on the wire"
#  7  0 1 0 0 0 0 0 1 (0x41)  housecode E (as "powerlinc code")
#  8  0 1 0 0 0 1 0 1 (0x45)  function "on" (as "powerlinc code")
#  9  0 0 1 1 0 0 0 1 (0x31)  once
# 10  0 0 0 0 1 1 0 1 (0x0D)  eot
#
# When I sent "e8 on" in calculated raw bits, only first bytes differ:
#  1  0 1 0 0 0 1 0 1 (0x45)  "placed on the wire"
#  2  0 1 0 0 0 0 0 1 (0x41)  housecode E (as "powerlinc code")
#  3  0 1 0 1 1 0 1 0 (0x5A)  unit 8 (as "powerlinc code")
#  4  0 0 1 1 0 0 0 1 (0x31)  once
#  5  0 0 0 0 1 1 0 1 (0x0D)  eot
#  1  0 1 0 0 0 1 0 1 (0x45)  "placed on the wire"
#  2  0 1 0 0 0 0 0 1 (0x41)  housecode E (as "powerlinc code")
#  3  0 1 0 0 0 1 0 1 (0x45)  function "on" (as "powerlinc code")
#  4  0 0 1 1 0 0 0 1 (0x31)  once
#  5  0 0 0 0 1 1 0 1 (0x0D)  eot
#
# Here's what was reported when I hit "e6 dim bright" on a controller:
#  1  0 1 1 1 1 0 0 0 (0x78)  "seen on the wire"
#  2  0 1 0 0 0 0 0 1 (0x41)  housecode E (as "powerlinc code")
#  3  0 1 0 1 0 0 1 0 (0x52)  unit 6 (as "powerlinc code")
#  4  0 0 1 1 0 0 0 1 (0x31)  once
#  5  0 0 0 0 1 1 0 1 (0x0D)  eot
#  1  0 1 1 1 1 0 0 0 (0x78)  "seen on the wire"
#  2  0 1 0 0 0 0 0 1 (0x41)  housecode E (as "powerlinc code")
#  3  0 1 0 0 1 0 0 1 (0x49)  function "dim" (as "powerlinc code")
#  4  0 0 1 1 0 0 0 1 (0x31)  once
#  5  0 0 0 0 1 1 0 1 (0x0D)  eot
#  1  0 1 1 1 1 0 0 0 (0x78)  "seen on the wire"
#  2  0 1 0 0 0 0 0 1 (0x41)  housecode E (as "powerlinc code")
#  3  0 1 0 0 1 0 1 1 (0x4B)  function "bright" (as "powerlinc code")
#  4  0 0 1 1 0 0 0 1 (0x31)  once
#  5  0 0 0 0 1 1 0 1 (0x0D)  eot
#
# Here's what was reported when I sent "e8 dirdim=50%" (old code):
#  1  0 1 0 0 0 1 0 1 (0x45)  "placed on the wire"
#  2  0 1 0 0 0 0 0 1 (0x41)  housecode E (as "powerlinc code")
#  3  0 1 0 1 1 0 1 0 (0x5A)  unit 8 (as "powerlinc code")
#  4  0 0 1 1 0 0 0 1 (0x31)  once
#  5  0 0 0 0 1 1 0 1 (0x0D)  eot
#  1  0 1 0 0 0 1 0 1 (0x45)  "placed on the wire"
#  2  0 1 0 0 0 0 0 0 (0x40)  level LSB 00 (as "powerlinc code" 0x40)
#  3  0 1 0 1 0 1 1 1 (0x57)  function "preset dim high" (as "powerlinc code")
#  4  0 0 1 1 0 0 0 1 (0x31)  once
#  5  0 0 0 0 1 1 0 1 (0x0D)  eot
#
# Here's what was reported when I sent "e8 extcode dirdim level"
# ( 0xE5 0x66 0xAA 0x99 0x99 0x95 0x69 0x58 0x00)
#  1  0 1 0 0 0 1 0 1 (0x45)  "placed on the wire"
#  2  1 1 1 0 0 1 0 1 (0xE5)  literal bits: if high nybble is start code
#  3  0 1 1 0 0 1 1 0 (0x66)  literal bits
#  4  1 0 1 0 1 0 1 0 (0xAA)  literal bits
#  5  1 0 0 1 1 0 0 1 (0x99)  literal bits
#  6  1 0 0 1 1 0 0 1 (0x99)  literal bits
#  7  1 0 0 1 0 1 0 1 (0x95)  literal bits
#  8  0 1 1 0 1 0 0 1 (0x69)  literal bits
#  9  0 1 0 1 1 0 0 0 (0x58)  literal bits
# 10  0 0 0 0 1 1 0 1 (0x0D)  eot

# Print next 4 bytes: housecode, unit/function, repeat, EOT.
# Args are pass-by-reference; we modify the line count and byte array.
sub parse_4bytes_std($$)
{
  my ( $lineno_ref, $arrayref ) = @_;
  my ( $byte, $hc_hex, @bitstrings, @interps, $which, $level );
  my ( $housecode, $funcname, $unit, $tersereport );

  foreach $which ( "housecode", "unit/func", "repeat", "eot" )
  {
    $byte = shift @{$arrayref};
    ${$lineno_ref}++;
    push @bitstrings, sprintf($bitstring_fmt, ${$lineno_ref}, showbits($byte));

    if    ( $which eq "housecode" )
    {
      $hc_hex = $byte & 0x0f ; # last four bits encode housecode
      $housecode = $hc_x10_to_letter{$hc_hex};
      push @interps, sprintf("housecode='%s'",$housecode);
    }
    elsif ( $which eq "unit/func" )
    {
      my $fivebits = $byte & 0x1f ;    # last five bits are 4D + 1F
      my $func     = $fivebits & 0x01; # last bit is 1 for func, 0 for addr
      my $fourbits = $fivebits>>1;     # four bits of data
      if ( $func )
      {
        # Interpret data as a function
        $funcname = $func_x10_to_str{$fourbits};
        push @interps, sprintf("func='%s'",$funcname);
        # Alternative interpretation is needed for previous byte 
        # if "housecode" is really a level encoding for "ddim":
        if ( $funcname =~ /^ddim-/ )
        {
          my $hashkey = $funcname.sprintf("-0x%02x",$hc_hex);
          $level = $ddim_cmds_to_levels{$hashkey};
          $interps[0] = sprintf("level=%d/31",$level);
          my $level_100 = sprintf("%.0f",($level*100.00/31));
          $level_100 = 100 if ( $level >= 31 );
          $level_100 =   0 if ( $level <= 0  );
          $tersereport = sprintf("ddim=%d%%", $level_100);
        }
        else
        {
          $tersereport = "$housecode-$funcname";
        }
      }
      else
      {
        # Interpret data as an address
        $unit = $units_x10_to_num{$fourbits};
        push @interps, sprintf("unit='%s'",$unit);
        $tersereport = "$housecode$unit";
      }
    }
    elsif ( $which eq "repeat" )
    {
      # Ignore top byte:
      my $repeat = $byte & 0x0f;
      push @interps, sprintf("repeat='%d'",$repeat);
    }
    elsif ( $which eq "eot" )
    {
      if ( $byte == $EOT )
      {
        push @interps, "EOT";
      }
      else
      {
        push @interps, "error, EOT expected";
      }
    }
  }

  foreach $which ( 0 .. 3 )
  {
    verbose($bitstrings[$which].$interps[$which]);
  }

  # Issue terse report if not in quiet mode, with line breaks only if
  # needed to keep out of the way of verbose/debug output:
  if ( $verbose || $debug )
  {
    verbose($tersereport);
  }
  elsif ( ! $quiet )
  {
    print "$tersereport "; # space-separated
  }

}

# Print what we got back from the powerlinc.
sub parsereply
{
  my ( @bytes ) = @_;
  my ( $byte, $bitstring, $i, $need_cr );

  $i = 0;
  while ( @bytes )
  {
    $byte = shift @bytes;
    $i++;
    $bitstring = sprintf($bitstring_fmt, $i, showbits($byte));
    if    ( ( $byte == $RCVD_STD ) || ( $byte == $RCVD_STD_UNDOC ) )
    {
      verbose($bitstring."STD_CMD")       if ( $byte == $RCVD_STD );
      verbose($bitstring."STD_CMD_UNDOC") if ( $byte == $RCVD_STD_UNDOC );
      # Parse next 4 bytes as "standard" powerlinc response
      if ( scalar(@bytes) >= 4 )
      {
        parse_4bytes_std(\$i,\@bytes);
      }
      else
      {
        $bitstring = sprintf($bitstring_fmt, 0, "-");
        verbose($bitstring."*** unparsable (too short)");
        last;
      }
    }
    elsif ( ( $byte == $RCVD_EXT ) || ( $byte == $RCVD_EXT_UNDOC ) )
    {
      verbose($bitstring."EXT_CMD")       if ( $byte == $RCVD_EXT );
      verbose($bitstring."EXT_CMD_UNDOC") if ( $byte == $RCVD_EXT_UNDOC );

      # If the first nybble is the start code, these are literal bits:
      if ( @bytes && $bytes[0]>>4 == $START_CODE )
      {
        # Turn them back into bits, and interpret???
        # XXX NOT IMPLEMENTED
        print "\next bytes: " if ( !$debug && !$verbose && !$quiet );
        last;
      }
      else
      {
        # Parse next 4 bytes as "standard" powerlinc response
        if ( scalar(@bytes) >= 4 )
        {
          parse_4bytes_std(\$i,\@bytes);
        }
        else
        {
          $bitstring = sprintf($bitstring_fmt, 0, "-");
          verbose($bitstring."*** unparsable (too short)");
          last;
        }
      }
    }
    elsif ( $byte == $ACK )
    {
      verbose($bitstring."ACK");
      # Expect an EOT:
      if ( ! scalar(@bytes) )
      {
        $bitstring = sprintf($bitstring_fmt, 0, "-");
        verbose($bitstring."*** missing EOT");
        last;
      }
      else
      {
        my ( $eot );
        $eot       = shift @bytes; $i++;
        $bitstring = sprintf($bitstring_fmt, $i, showbits($eot));
        if ( $eot == $EOT )
        {
          verbose($bitstring."EOT");
        }
        else
        {
          verbose($bitstring."error, EOT expected");
        }
      }
    }
    elsif ( $byte == $NAK )
    {
      # Nothing more:
      verbose($bitstring."NAK");
    }
    else
    {
      # Error:
      verbose($bitstring."OUT OF SYNCH, skipping rest");
      print "\nout-of-synch bytes: " if ( !$debug && !$verbose && !$quiet );
      last;
    }
  }

  # Show rest of bytes even though we don't understand them:
  $need_cr = 0;
  while ( @bytes )
  {
    $byte = shift @bytes;
    $i++;
    $bitstring = sprintf($bitstring_fmt, $i, showbits($byte));
    verbose($bitstring."(skipped)");
    printf("0x%x ",$byte) if ( !$debug && !$verbose && !$quiet );
    $need_cr = 1;
  }
  print "\n" if ( $need_cr && !$debug && !$verbose && !$quiet );

}

sub print_status_if_error($$)
{
  my ( $subname, $status ) = @_;

  if ( ! $status )
  {
    printerr($subname, "no status returned");
  }
  elsif ( $status =~ /^err (.*)/ )
  {
    printerr($subname, "error reported: $1");
  }
  elsif ( $status !~ /^ok/ )
  {
    printerr($subname, "unrecognized status: $status");
  }
}

  
# ---------------------- command subroutines -------------------------

# listen to serial port and report
sub loop_listen()
{
  my $subname = "loop_listen";
  my ( @bytes, $status );

  while ( 1 )
  {
    ($status, @bytes) = getreply($UNKNOWN);
    if ( $status =~ /^err reply too short/ )
    {
      # Nothing...
    }
    else
    {
      print_status_if_error($subname, $status);
    }
    select(undef, undef, undef, $SLEEP_LOOP); 
  }
}


# test pattern (for debugging)
sub test_pattern()
{
  my $subname = "test_pattern";
  my ( @bytes, $status );
  my $housecode = "E";
  my $unitcode  = 8;

# --- try extended code for direct dim

# ----- encoding for extended command:
# cycles 1 to 11 as above, where D8,D4,D2,D2,F1 = "ext1",
# then starting at cycle 12:
# *----*----*----*----*----*----*----*----*----*----*----*----*
# * 12 * 13 * 14 * 15 * 16 * 17 * 18 * 19 * 20 * 21 * 22 * 23
# *----*----*----*----*----*----*----*----*----*----*----*----*
#  A8A8 A4A4 A2A2 A1A1 D128 D64  D32  D16  D8D8 D4D4 D2D2 D1D1
# *-------------------*---------------------------------------*
# * ADDRESS           * DATA, all complemented                *
#
# *----*----*----*----*----*----*----*----*
# * 24 * 25 * 26 * 27 * 28 * 29 * 30 * 31 *
# *----*----*----*----*----*----*----*----*
#  C8C8 C4C4 C2C2 C1C1 C8C8 C4C4 C2C2 C1C1
# *---------------------------------------*
# * COMMAND                               * no end of message?
# 
# HOUSECODE SETTING       H8      H4      H2      H1
#         E               0       0       0       1
# 
# ADDRESS                 D8      D4      D2      D1     F1
#         8               1       1       0       1      0
# 
# FUNCTION                D8      D4      D2      D1     F1
#         EXT1            0       1       1       1      1    FOR DATA/CONTROL
# 
# DATA AND COMMAND
#                          DATA BITS               CMD BYTES
#                         -----------------------  ---------
#                         D  D  D  D  D  D  D  D   CA CB
# 
#         DIRECT DIM      x  x  B16B8 B4 B2 B1 B0   3  1   * see note
#   REQ.OUTPUT STATUS     x  x  0  0  x  x  x  x    3  7 (Req. TO module)
#   OUTPUT STATUS ACK     A1 A0 B16B8 B4 B2 B1 B0   3  8   * see note
# 
# Note on DIRECT DIM:
#   B bits all zero = off, some non-zero = on
#   For dimmers:
#    B = 0x00        : off
#    B = 0x3F        : on full bright
#    B = 0x01 to 0x3e: on at previous setting (or at full dim if off),
#                      then fade to requested value
# 
# Note on OUTPUT STATUS ACK:
#    A1 = '1' if load connected
#    A0 = '0' for dimmer, '1' for appliance module
#    B is (presumably) dim level???

# Therefore, direct dim:
# *----*----*----*----*----*----*----*----*----*----*----*
# * 1  * 2  * 3  * 4  * 5  * 6  * 7  * 8  * 9  * 10 * 11 
# *----*----*----*----*----*----*----*----*----*----*----*
#   1 1  1 0  0 1  0 1  0 1  1 0  0 1  1 0  1 0  1 0  1 0
# *---------*-------------------*------------------------*
# * START   *   HOUSECODE E     *   EXT1                 *
my @hc_bits = bit_complements(number_to_bits(4,$hc_letter_to_x10{$housecode}));
my @af_bits = bit_complements(number_to_bits(4,$func_str_to_x10{"extended"}),1);
#
# *----*----*----*----*----*----*----*----*----*----*----*----*
# * 12 * 13 * 14 * 15 * 16 * 17 * 18 * 19 * 20 * 21 * 22 * 23
# *----*----*----*----*----*----*----*----*----*----*----*----*
#   1 0  1 0  0 1  1 0  x x  x x  0 1  1 0  0 1  0 1  0 1  0 1
# *-------------------*---------------------------------------*
# * ADDRESS 8         * LEVEL, say 50% = 0x20 = 010000        *
#                       level calculation may be totally wrong...
my @addr_bits = bit_complements(number_to_bits(4,$units_num_to_x10{$unitcode}));
my @data_bits         = bit_complements( 0, 1, 0, 1, 0, 1, 0, 0 );
my @statreq_data_bits = bit_complements( 0, 0, 0, 0, 0, 0, 0, 0 );
#
# *----*----*----*----*----*----*----*----*----*----*----*
# * 24 * 25 * 26 * 27 * 28 * 29 * 30 * 31 * 32 * 33 * 34 *
# *----*----*----*----*----*----*----*----*----*----*----*
#   0 1  0 1  1 0  1 0  0 1  0 1  0 1  1 0  0 0  0 0  0 0
# *---------------------------------------*--------------*
# * COMMAND DIRECT DIM (3,1)              * ZERO GAP     *
my @cmd_bits           = bit_complements(number_to_bits(8, 0x31));
my @statreq_cmd_bits   = bit_complements(number_to_bits(8, 0x37));
my @end_gap            = number_to_bits(6,$END_CODE);

# XXX my @all_bits = ( number_to_bits(4,$START_CODE), @hc_bits, @af_bits,
# XXX                  @addr_bits, @data_bits, @cmd_bits, @end_gap );
my @all_bits = ( number_to_bits(4,$START_CODE), @hc_bits, @af_bits, 
                 @addr_bits, @statreq_data_bits, @statreq_cmd_bits, @end_gap );
my @all_bytes = bits_to_bytes(@all_bits);

my @ext_data = @all_bytes;
my $byte_count = scalar(@ext_data);

#debug($subname, 
#      "Sending: extended code (preset dim) to $housecode$unitcode");
debug($subname, 
      "Sending: extended code (status request) to $housecode$unitcode");
send_to_powerlinc($SEND_EXT, $byte_count, @ext_data );
($status, @bytes) = getreply($UNKNOWN);
print_status_if_error($subname, $status);
# more reply?
($status, @bytes) = getreply($UNKNOWN);
print_status_if_error($subname, $status);

  # All's well:
  return();
}


# Returns true if the command given in the hashref is a *standard* X10
# command (as opposed to an extended X10 command).
sub is_standard_x10_command($)
{
  my ( $cmdhashref ) = @_;
  my $subname = "is_standard_x10_command";
  my $type    = $cmdhashref->{"type"};
  my $command = $cmdhashref->{"command"};

  die "INTERNAL ERROR: garbage item passed to $subname"
    unless defined($type);
 
  die "INTERNAL ERROR: non-command item passed to $subname"
    unless $type eq "command";
 
  if ( defined($func_str_to_x10{$command}) )
  {
    return 1;
  }
  else
  {
    return undef;
  }
}


sub issue_x10_standard_address($$)
{
  my ( $housecode, $unitcode) = @_;
  my $subname = "issue_x10_standard_address";
  my ( @hc_bits, @addr_bits, $funcaddr_bit, @all_bits, $status, @bytes );

  verbose("$subname hc=$housecode, u=$unitcode");

  @hc_bits      = number_to_bits(4,$hc_letter_to_x10{$housecode});
  @addr_bits    = number_to_bits(4,$units_num_to_x10{$unitcode});
  $funcaddr_bit = 0;  # This is an address code, not a function code
  @all_bits     = ( number_to_bits(4,$START_CODE),
                    bit_complements(@hc_bits, @addr_bits, $funcaddr_bit),
                    number_to_bits(4,$END_CODE) );
  # XXX DOUBLE IT BEFORE THE ZEROES?

  # Send it:
  send_rawdata(@all_bits);
  ($status, @bytes) = getreply($STD_RESP_LEN);
  print_status_if_error($subname, $status);
}


# ------ encoding for standard command:
# *----*----*----*----*----*----*----*----*----*----*----*---*--*
# * 1  * 2  * 3  * 4  * 5  * 6  * 7  * 8  * 9  * 10 * 11 *   *
# *----*----*----*----*----*----*----*----*----*----*----*---*--*
#   1 1  1 0 H8H8 H4H4 H2H2 H1H1 D8D8 D4D4 D2D2 D1D1 F1F1  00 00
# *---------*-------------------*-------------------*----*------*
# * START   *   HOUSECODE       *ADDRESS/FUNCTION   *FUNC*END OF
# * CODE    *                   *                   *TION*MESSAGE*
# 
# (where H8H8 reads as H8 H8bar, etc., and *  * denotes a powerline cycle.)
# FUNCTION = 0 indicates a unit code, FUNCTION = 1 indicates a command
sub issue_x10_standard_command($$)
{
  my ( $housecode, $cmdhashref ) = @_;
  my $subname = "issue_x10_standard_command";
  my $type    = $cmdhashref->{"type"};
  my $command = $cmdhashref->{"command"};
  my $level   = defined($cmdhashref->{"level"}) ? $cmdhashref->{"level"}
                                                : "NOLEVEL";
  my ( @hc_bits, @func_bits, $funcaddr_bit, @all_bits, $status, @bytes );

  die "INTERNAL ERROR: non-command item passed to $subname"
    unless $type eq "command";
 
  verbose("$subname hc=$housecode, cmd=$command, level=$level");

  if ( $command eq "ddim" )
  {
    my ( $level_32, $level_encoding );
    # Calculate how to express level.  We got:
    #   0 = dimmest   to   100 = full bright
    # Translate to:
    #   0x00 (5 bits) to 0x1f (5 bits)  (32 levels)
    $level_32       = sprintf("%.0f", $level * 31.00 / 100.00 );
    $level_32       = 0  if ( ( $level_32 < 0  ) || ( $level <= 0   ) );
    $level_32       = 31 if ( ( $level_32 > 31 ) || ( $level >= 100 ) );
    # Now encode that "level out of 32" to a command and "housecode":
    $command        = $ddim_levels_to_cmds{$level_32}->[0];
    $level_encoding = $ddim_levels_to_cmds{$level_32}->[1];
    @hc_bits = number_to_bits(4,$level_encoding);
    debug($subname, sprintf("level %d (%d/31) => '%s' 0x%x",
                            $level, $level_32, $command, $level_encoding));
  }
  else
  {
    @hc_bits = number_to_bits(4,$hc_letter_to_x10{$housecode});
  }

  @func_bits    = number_to_bits(4,$func_str_to_x10{$command});
  $funcaddr_bit = 1;  # This is a function code, not an address code
  @all_bits     = ( number_to_bits(4,$START_CODE),
                    bit_complements(@hc_bits, @func_bits, $funcaddr_bit),
                    number_to_bits(4,$END_CODE) );
  # XXX DOUBLE IT BEFORE THE ZEROES?

  # Send it:
  send_rawdata(@all_bits);
  # If we're expecting an answer, get it as well:
  if ( $expects_answer{$command} )
  {
    ($status, @bytes) = getreply($UNKNOWN);
    unless ( scalar(@bytes) > $STD_RESP_LEN )
    {
      printerr($subname, "no reply received");
    }
  }
  else # get just the expected "std reply" bytes:
  {
    ($status, @bytes) = getreply($STD_RESP_LEN);
  }
  print_status_if_error($subname, $status);

}


# ----- encoding for extended command:
#
# cycles 1 to 11 as for standard protocol, where D8,D4,D2,D2,F1 = "ext1":
# *----*----*----*----*----*----*----*----*----*----*----*
# * 1  * 2  * 3  * 4  * 5  * 6  * 7  * 8  * 9  * 10 * 11 *
# *----*----*----*----*----*----*----*----*----*----*----*
#   1 1  1 0 H8H8 H4H4 H2H2 H1H1 D8D8 D4D4 D2D2 D1D1 F1F1 
# *---------*-------------------*-------------------*----*
# * START   *   HOUSECODE       *ADDRESS/FUNCTION   *FUNC*
# * CODE    *                   *                   *TION*
# 
# then starting at cycle 12:
# *----*----*----*----*----*----*----*----*----*----*----*----*
# * 12 * 13 * 14 * 15 * 16 * 17 * 18 * 19 * 20 * 21 * 22 * 23
# *----*----*----*----*----*----*----*----*----*----*----*----*
#  A8A8 A4A4 A2A2 A1A1 D128 D64  D32  D16  D8D8 D4D4 D2D2 D1D1
# *-------------------*---------------------------------------*
# * ADDRESS           * DATA, all complemented                *
#
# *----*----*----*----*----*----*----*----*
# * 24 * 25 * 26 * 27 * 28 * 29 * 30 * 31 *
# *----*----*----*----*----*----*----*----*
#  C8C8 C4C4 C2C2 C1C1 C8C8 C4C4 C2C2 C1C1
# *---------------------------------------*
# * COMMAND                               * no end of message?
# 
# 
# DATA AND COMMAND BITS:
#                          DATA BITS               CMD BYTES
#                         -----------------------  ---------
#                         D  D  D  D  D  D  D  D   CA CB
# 
#         DIRECT DIM      x  x  B16B8 B4 B2 B1 B0   3  1   * see note
#   REQ.OUTPUT STATUS     x  x  0  0  x  x  x  x    3  7 (Req. TO module)
#   OUTPUT STATUS ACK     A1 A0 B16B8 B4 B2 B1 B0   3  8   * see note
# 
# Note on DIRECT DIM:
#   B bits all zero = off, some non-zero = on
#   For dimmers:
#    B = 0x00        : off
#    B = 0x3F        : on full bright
#    B = 0x01 to 0x3e: on at previous setting (or at full dim if off),
#                      then fade to requested value
# 
# Note on OUTPUT STATUS ACK:
#    A1 = '1' if load connected
#    A0 = '0' for dimmer, '1' for appliance module
#    B is (presumably) dim level???
#
sub issue_x10_extended_command($$$)
{
  my ( $housecode, $unitcode, $cmdhashref ) = @_;
  my $subname = "issue_x10_extended_command";
  my $type    = $cmdhashref->{"type"};
  my $command = $cmdhashref->{"command"};
  my $level   = $cmdhashref->{"level"} ? $cmdhashref->{"level"} : "NOLEVEL";

  die "INTERNAL ERROR: non-command item passed to $subname"
    unless $type eq "command";
 
  verbose("$subname hc=$housecode, u=$unitcode, level=$level");
  verbose("$subname not implemented");
  # XXX IMPLEMENT THIS SOMEDAY!
}

# Issue all stacked commands to all stacked addresses, sorting the
# addresses in groups by housecode.  Note that most standard X10
# commands go in "addr addr... cmd cmd..." groups, while "ddim"
# standard X10 commands must go as "addr cmd" pairs and extended X10
# commands go as a single addr-and-cmd.  Make sure to keep the commands
# in the right order.  For example, this:
#    e9,8 f7 on dim ddim=50 ext_statreq bright
# Should go as:
#    e8 e9 on dim f7 on dim  
#    e8 ddim=50 e9 ddim=50 f7 ddim=50
#    e8-ext_statreq e9-ext_statreq f7-ext_statreq
#    e8 e9 bright f7 bright  
sub issue_stacked_commands()
{
  my ( @std_command_batch, $housecode, $unitcode, $item );
  my $subname = "issue_stacked_commands";

  debug($subname, "CALLED");
  debug($subname, "  WITH ADDRESSES: ".show_current_addresses());
  debug($subname, "  WITH COMMANDS: ".show_current_commands());

  while ( @commands )
  {
    # if next command is standard but not ddim, 
    # issue unit addresses, then command(s)
    if ( is_standard_x10_command($commands[0]) &&
         ( $commands[0]->{"command"} ne "ddim" ) )
    {
      @std_command_batch = ();
      while ( @commands && is_standard_x10_command($commands[0]) )
      {
        push @std_command_batch, (shift @commands);
      }

      foreach $housecode ( sort keys %addresses )
      {
        # issue unit addresses
        foreach $unitcode ( sort keys %{$addresses{$housecode}} )
        {
          issue_x10_standard_address($housecode, $unitcode);
        }
        # issue commands
        foreach $item ( @std_command_batch )
        {
          issue_x10_standard_command($housecode, $item);
        }
      }

    }
    # if next command is std ddim, issue addr,cmd pairs
    elsif ( is_standard_x10_command($commands[0]) &&
            ( $commands[0]->{"command"} eq "ddim" ) )
    {
      $item = shift @commands;
      foreach $housecode ( sort keys %addresses )
      {
        foreach $unitcode ( sort keys %{$addresses{$housecode}} )
        {
          issue_x10_standard_address($housecode, $unitcode);
          issue_x10_standard_command($housecode, $item);
        }
      }
    }
    else # if next command is extended, issue addr-cmd blocks
    {
      $item = shift @commands;
      foreach $housecode ( sort keys %addresses )
      {
        foreach $unitcode ( sort keys %{$addresses{$housecode}} )
        {
          issue_x10_extended_command($housecode, $unitcode, $item);
        }
      }
    }

  } # while @commands
}


# Initialize the state machine and related globals.
sub initialize_state()
{
  %addresses = ();
  @commands  = ();
  $curstate  = "initial"
}


# ---------------------- main program --------------------------------

# Turn off buffering on stdout, we need to see output as it is generated.
$| = 1;

# First just parse the arguments, stacking up addresses and commands,
# unless a one-word commands (help, test, listen) is found, in which
# case execute it.
while ( @ARGV )
{
  my $arg = shift @ARGV;

  $arg =~ s/^\s+//; # strip leading space
  $arg =~ s/\s+$//; # strip trailing space
  next unless $arg; # quietly skip empty arguments

  #    -d  turn on debugging output
  if    ( $arg eq '-d' )
  {
    $debug   = 1;
    $verbose = 1;
    $quiet   = 0;
    debug($subname, "debug is on");
  }

  #    -v  turn on verbose output
  elsif ( $arg eq '-v' )
  {
    $verbose = 1;
    $quiet   = 0;
    debug($subname, "verbose is on");
  }

  #    -q  quiet, turn off all non-error output
  elsif ( $arg eq '-q' )
  {
    $quiet   = 1;
    debug($subname, "quiet is on");
  }

  #    (no other options are valid)
  elsif ( $arg =~ /^-$/ )
  {
    usage("Unknown option '$arg'");
  }

  #   help
  #       show this message
  elsif ( $arg =~ /^help$/i )
  {
    long_usage();
  }

  #    prog=<metacmd>
  #        issue command sequence for module programming, where 
  #        <metacmd> is [ clear setramp defonlevel addscene delscene rampscene ]
  elsif ( $arg =~ /^prog=([a-z]*)$/i )
  {
    my ( $metacmd, @sequence, $seqpart );
    usage("'prog' must be the only command if used")
      unless ( ! @ARGV and ! @PARSED_ARGS );
    $metacmd = lc($1); # untainted but not semantically checked
    if    ( $metacmd eq "clear" )
    {
      @sequence = ( ["O",16], ["N",16], ["M",16], ["P",16], ["M",16] );
    }
    elsif ( $metacmd eq "setramp" )
    {
      @sequence = ( ["O",16], ["P",16], ["N",16], ["M",16], ["O",16] );
    }
    elsif ( $metacmd eq "defonlevel" )
    {
      @sequence = ( ["P",16], ["N",16], ["M",16], ["O",16], ["O",16]);
    }
    elsif ( $metacmd eq "addscene" )
    {
      @sequence = ( ["M",16], ["N",16], ["O",16], ["P",16] );
    }
    elsif ( $metacmd eq "delscene" )
    {
      @sequence = ( ["O",16], ["P",16], ["M",16], ["N",16] );
    }
    elsif ( $metacmd eq "rampscene" )
    {
      @sequence = ( ["N",16], ["O",16], ["P",16], ["M",16] );
    }
    else
    {
      usage("Unrecognized meta-command '$metacmd'");
    }
    set_up_serial_port() unless $ready;
    debug($subname, "issuing the metacommand '$metacmd' sequence");
    foreach $seqpart ( @sequence )
    {
      my $hc   = $seqpart->[0];
      my $unit = $seqpart->[1];
      issue_x10_standard_address($hc, $unit);
    }
    goto THE_END;
  }

  #    test
  #        issue hardcoded test pattern (for debugging only)
  elsif ( $arg =~ /^test$/i )
  {
    usage("'test' must be the only command if used")
      unless ( ! @ARGV and ! @PARSED_ARGS );
    set_up_serial_port() unless $ready;
    debug($subname, "executing the test pattern");
    test_pattern();
    goto THE_END;
  }

  #    listen
  #        loop listening on serial port and report traffic seen
  elsif ( $arg =~ /^listen$/i )
  {
    usage("'listen' must be the only command if used")
      unless ( ! @ARGV and ! @PARSED_ARGS );
    set_up_serial_port() unless $ready;
    debug($subname, "entering the listening loop");
    loop_listen();
    goto THE_END;
  }

  #   <addr>    is Hn or Hn,p,q...  where H is a housecode A-P
  #                                 and n,p,q are unit codes 1-16
  elsif ( $arg =~ /^([a-z])(\d[\d,]*)$/i )
  {
    my ( $housecode, $units, @units, $unit );
    $housecode = uc($1); # untainted but not semantically checked
    $units     =    $2;  # untainted but not semantically checked or split

    unless ( $housecode =~ /^[A-P]$/ )
    {
      usage("invalid housecode '$housecode' (must be A-P)");
    }

    # split units
    @units = split /,/, $units;

    foreach $unit ( @units )
    {
      unless ( $unit && ( $unit >= 1 ) && ( $unit <= 16 ) )
      {
        usage("invalid unit code '$unit' (must be 1-16)");
      }
      push @PARSED_ARGS, { "type"      => "address",
                           "housecode" => $housecode,
                           "unitcode"  => $unit,
                         };
      debug($subname, "arg: got address $housecode$unit");
    }

  }

  #   <cmd>     is [ on off bright dim statreq ddim=n ]
  #                                 where n is percent brightness 0-100
  elsif ( $arg =~ /^on|off|bright|dim|statreq|ddim=\d+$/i )
  {
    my ( $command, $level );
    if ( $arg =~ /^(on|off|bright|dim|statreq)$/i )
    {
      $command   = lc($1); # untainted and valid command
      push @PARSED_ARGS, { "type"      => "command",
                           "command"   => $command,
                         };
      debug($subname, "arg: got command $command");
    }
    elsif ( $arg =~ /^ddim=(\d+)%?$/i )
    {
      $command   = "ddim"; # untainted and valid command
      $level     = $1;     # untainted but not semantically checked
      unless ( ( $level >= 0 ) && ( $level <= 100 ) )
      {
        usage("invalid ddim level '$level' (must be 0-100)");
      }
      push @PARSED_ARGS, { "type"      => "command",
                           "command"   => $command,
                           "level"     => $level,
                         };
      debug($subname, "arg: got command $command=$level");
    }
  }

  else
  {
    usage("Unrecognized command '$arg'");
  }

} # end argument processing



# Now process the addresses and commands collected:
#
initialize_state();
if ( @PARSED_ARGS )
{
  push @PARSED_ARGS, { "type" => "end" };
  set_up_serial_port() unless $ready;
}
while ( @PARSED_ARGS )
{
  $oldstate = $curstate;
  my ( $item, $type, $housecode, $unitcode, $command );

  if    ( $curstate eq "initial" )
  # initial state:                read an arg, then:
  {
    $item     = shift @PARSED_ARGS;
    $type     = $item->{"type"};

    if    ( $type eq "address" )
    {
      # address: stack it, go to address collection state
      $housecode = $item->{"housecode"};
      $unitcode  = $item->{"unitcode"};
      $addresses{$housecode} = {} unless $addresses{$housecode};
      $addresses{$housecode}->{$unitcode} = 1;
      $curstate = "address collection";
      debug($subname, sprintf("collected address %s%d", $housecode, $unitcode));
      debug($subname, sprintf("STATE TRANSITION: %-20s -> %s",
                              $oldstate, $curstate));
    }
    elsif ( $type eq "command" )
    {
      # command: error: no addresses supplied
      $command = $item->{"command"};
      usage("no addresses supplied before command '$command'");
    }
    elsif ( $type eq "end" )
    {
      # end of args: (end)
      debug($subname, sprintf("STATE TRANSITION: %-20s -> %s",
                              $oldstate, "END"));
      last;
    }
    else
    {
      die "INTERNAL ERROR: unknown item type '$type' in state '$curstate'";
    }

  }
  elsif ( $curstate eq "address collection" )
  # address collection state:     read an arg, then:
  {
    $item     = shift @PARSED_ARGS;
    $type     = $item->{"type"};

    if    ( $type eq "address" )
    {
      # address: stack it, stay in address collection state
      $housecode = $item->{"housecode"};
      $unitcode  = $item->{"unitcode"};
      $addresses{$housecode} = {} unless $addresses{$housecode};
      $addresses{$housecode}->{$unitcode} = 1;
      $curstate = "address collection";
      debug($subname, sprintf("collected address %s%d", $housecode, $unitcode));
      debug($subname, sprintf("STATE TRANSITION: %-20s -> %s",
                              $oldstate, $curstate));
    }
    elsif ( $type eq "command" )
    {
      # command: stack it, go to command collection state
      $command = $item->{"command"};
      push @commands, $item;
      $curstate = "command collection";
      debug($subname, sprintf("collected command %s", $command));
      debug($subname, sprintf("STATE TRANSITION: %-20s -> %s", 
                              $oldstate, $curstate));
    }
    elsif ( $type eq "end" )
    {
      # end of args: error: no command supplied
      usage("no command supplied after address(es) ".show_current_addresses());
    }
    else
    {
      die "INTERNAL ERROR: unknown item type '$type' in state '$curstate'";
    }

  }
  elsif ( $curstate eq "command collection" )
  # command collection state:     read an arg, then:
  {
    $item     = shift @PARSED_ARGS;
    $type     = $item->{"type"};

    if    ( $type eq "address" )
    {
      # address: PUSH IT BACK, go to command issuing state
      unshift @PARSED_ARGS, $item;
      $curstate = "command issuing";
      debug($subname, "pushed back an address");
      debug($subname, sprintf("STATE TRANSITION: %-20s -> %s", 
            $oldstate, $curstate));
    }
    elsif ( $type eq "command" )
    {
      # command: stack it, stay in command collection state
      $command = $item->{"command"};
      push @commands, $item;
      $curstate = "command collection";
      debug($subname, sprintf("collected command %s", $command));
      debug($subname, sprintf("STATE TRANSITION: %-20s -> %s",
                              $oldstate, $curstate));
    }
    elsif ( $type eq "end" )
    {
      # end of args: go to command issuing state
      $curstate = "command issuing";
      debug($subname, sprintf("STATE TRANSITION: %-20s -> %s", 
                              $oldstate, $curstate));
    }
    else
    {
      die "INTERNAL ERROR: unknown item type '$type' in state '$curstate'";
    }

  }
  elsif ( $curstate eq "command issuing" )
  # command issuing state:        issue pending commands to addresses,
  #                               then clear all and go to initial state
  {
    issue_stacked_commands();
    initialize_state();
    debug($subname, sprintf("STATE TRANSITION: %-20s -> %s", 
          $oldstate, $curstate));
  }
  else
  {
    die sprintf("INTERNAL ERROR: unknown state '%s'",$curstate);
  }

}
# Finish the job:
if ( $curstate eq "command issuing" )
{
  issue_stacked_commands();
  initialize_state();
  debug($subname, sprintf("STATE TRANSITION: %-20s -> %s",
                          $oldstate, $curstate));
}

THE_END:
if ( $ready )
{
  clean_up_serial_port();
}
else
{
  usage("Please specify at least one command");
}

# If we've been echoing commands in "regular" mode:
if ( !$debug && !$verbose && !$quiet )
{
  print "\n";
}

exit(0);