Insteon‎ > ‎

Perl PLM Demo

Start with some basic declarations.

#!/usr/bin/perl
use strict;
use Device::SerialPort;
use Toolbox::Simple qw(dec2hex);
use Time::HiRes qw(gettimeofday tv_interval);

Great!  Now this next line is important.  You should change it to suit your environment.  Please note that this script was written to run in a linux environment.

my $port = "/dev/ttyS0";
   #If using a USB-serial adapter, make the above /dev/ttyUSB0
my $baud = 19200;

Let's move on to the guts of our program.  We'll start by building our port.  I tend to put things in subs for organizational purposes, which can help with abstraction down-the-line.

my $tty;
&buildPortObject($port);
sub buildPortObject{
    my $systemPort = shift;
    my $portType = shift;
    my $portDriver = shift;
    
    #TODO: Nobody cares.  I should look in both!  I should also check with a ping/ACK to see that
    #      whatever is connected is a PLM!
    #TODO: Fix broken logic: will not work when multiple serial ports of same driver are installed.
    $portType = "usbserial" if lc($portType eq "usb");
    $portType = "serial" if lc($portType eq  "serial");
    
    if(defined($portType) and defined($portDriver)){
my $procInfo;
eval{
   $procInfo = `cat /proc/tty/driver/$portType |grep "$portDriver"`;
};if($@){
   warn "A Fallback was given to &buildPortObject, but I couldn't read from /proc!\n";
}else{
   if($procInfo =~ m/(\d+):/){
my $which = $1;
$portType = "USB" if $portType eq "usbserial";
$portType = "" if $portType eq "serial";
if("/dev/tty$portType$which" eq $systemPort){
   #Do Nothing
}else{
   warn "I changed the port to /dev/tty$portType$which because it looked more accurate.\n";
   $systemPort = "/dev/tty$portType$which";
}
   }else{
warn "I did not understand what I read from /proc.\n";
   }
}
    }else{
warn "No fallback method was given to &buildPortObject.\n";
    }
    eval{
       $tty=Device::SerialPort->new($systemPort);
       $tty->databits(8);
       $tty->baudrate($baud);
       $tty->parity("none");
       $tty->stopbits(1);
       $tty->write_settings;
       $tty->error_msg(1);
       $tty->user_msg(0);
    };if($@){
eval{$tty->close};
undef($tty);
die("Could not open serial port: $systemPort\n");
    }
    print "I'm ready for your commands now!\n";
}

Now here's an important sub.  This sends data.  I had it go directly to calling a &tty_get after sending data because we should get a response from the PLM.  If nothing else, we should get a 15, which is a hexadecimal representation of NAK, or no-acknowledgement, which means the PLM didn't understand what we sent.

sub tty_send {
    my ($device, $data) = @_;
    #Because getting a reply depends upon my data being a good Insteon message,
    #TODO: I should add some error-checking to $data.
    my $b   = pack('H*',$data); # Convert from string to bin
    my $l   = do { use bytes; length($b) }; # Get it's length

    printf("T = %s (%d)\n", unpack('H*', $b), $l);
    $device->write($b) or warn("Could not write to port!\n");
    #sleep(1); #Allow time for a response; this is now built in to &tty_get
    tty_get($device, $data);
}

And here's our get method.  As with &tty_send, I'm not doing any real error detection or recovery.  The really important thing to notice in these subs is how the data is packed and unpacked.  I found this logic online.  Credit: http://www.linuxha.com/athome/common/iplcd/iplc_serial_pl.gz

sub tty_get {
    #The PLM features software flow-control that echos what we sent it.  This
    #echo is followed by an ACK (0x06), and then we get the real reply beginning
    #with a STX (0x02).
    #If we get a NAK (0x15), the PLM is busy, and the command should be resent.
    #TODO: better manage responses!
    my ($device, $sent, $wait) = @_;
    $wait = 5 unless $wait;
    my $done;
    my $got;
    my $start = [gettimeofday];
    do{
my $in;
        $got .= $device->input;
my $duration = tv_interval($start, [gettimeofday]);
if($got) {
        $in = unpack('H*', $got);
        #This error checking is *very* basic.  I'm looking for the ACK from
        #the PLM so I can ignore it, and just print out the real reply.
        if($in =~ m/$sent(06)(.+)/){
printf("R <= %s\n", $2);
$done = 1;
        }
}
sleep(1);
if($duration > $wait and !$done){
$done = 1;
#TODO: not entirely accurate.  This also gets called if
#      $in isn't what I was expecting.
print "No response received! (got is: $in)\n";
}
    } while(!$done);
}

Fantastic!  With our methods done, we can just write our main loop.  Let's convert a few commands from PLM/insteon protocol into english.  See the if logic.  Notice again that I'm not doing any error detection, but assuming the user knows how to use this program!

my $input;
do{
    $input = <STDIN>;
      chomp($input);
      $input = lc($input);
      if($input eq "on"){
#Type "on" at the prompt to turn on the demo light.
tty_send($tty, "02621111110511ff");
      }elsif($input eq "off"){
#Type "off" at the prompt to turn off the demo light.
tty_send($tty, "02621111110513ff");
      }elsif($input =~ m/request (......)/){
tty_send($tty, "0262$1"."050300");
      }elsif($input =~ m/version (......)/){
tty_send($tty, "0262$1"."050d00");
      }elsif($input =~ m/lighton (......)/){
tty_send($tty, "0262$1"."0511FF");
      }elsif($input =~ m/lightoff (......)/){
tty_send($tty, "0262$1"."051300");
      }elsif($input =~ m/lightsetx (......) (..)/){
#Use this command to send a light dimmer control using hex as $2.
#For example: lightsetx 111111 7f
#Would tell device 11-11-11 to turn on to 50% (50% of 0xFF (or 255) converted to hex is 7f)
tty_send($tty, "0262$1"."0511$2");
      }elsif($input =~ m/lightset (......) (..)/){
#This is easier than lightsetx because you just give a percent as $2 (01%-99%)
#And this will convert to proper hex for you!
my $TMPpercent = dec2hex(int(255*($2/100)));
tty_send($tty, "0262$1"."0511$TMPpercent");
      }elsif($input =~ m/lightstatus (......)/){
#Get the light status -- how bright is it?
tty_send($tty, "0262$1"."051900");
      }elsif($input =~ m/water (......) (..)/){
#Where $1 is the device address, and $2 is the relay number
#For example: water 111111 00
#If I had an EZIO with address 11-11-11, this would turn on relay 1 because they start with 0, not 1.
tty_send($tty, "0262" . $1 . "0545" . $2);
sleep(5*60); #Water it for 5 minutes
tty_send($tty, "0262" . $1 . "0546" . $2);
      }elsif($input eq ""){
#Just check if there's anything in the buffer.
tty_get($tty);
      }elsif($input eq "exit"){
eval{$tty->close};
undef($tty);
exit;
      }else{
tty_send($tty, $input);
      }
}while(1);

UPDATE: I added some fault tolerance to &get and &send.  See the difference below (and notice that it's only partially implemented -- it only receives an SD or ED message:

sub tty_send {
    my ($device, $data) = @_;
    #Because getting a reply depends upon my data being a good Insteon message,
    #TODO: I should add some error-checking to $data.
    my $b   = pack('H*',$data); # Convert from string to bin
    my $l   = do { use bytes; length($b) }; # Get it's length

    printf("T = %s (%d)\n", unpack('H*', $b), $l);
    my $tries = 0;
    do{
        $device->write($b) or warn("Could not write to port!\n");
$tries++;
if($tries > 3){
   print "PLM could not process command: $data\n";
   return(1);
}
        sleep(1);
    }while(tty_get($device, $data));
}
sub tty_get {
    #The PLM features software flow-control that echos what we sent it.  This
    #echo is followed by an ACK (0x06), and then we get the real reply beginning
    #with a STX (0x02).
    #If we get a NAK (0x15), the PLM is busy, and the command should be resent.
    my ($device, $sent, $wait) = @_;
    $wait = 5 unless $wait;
    my $done;
    my $got;
    my $start = [gettimeofday];
    my $waitForPLM = 1;
    do{
my $in;
my $duration;
        $got .= $device->input;
$duration = tv_interval($start, [gettimeofday]);

if(defined($waitForPLM)){
   if($got){
$in = unpack('H*', $got);
if($in =~ m/$sent(06)(.+)/){
                    #Let's repack any overflow to $got, 
                    #then tell our logic we're done waiting for the PLM
   $got = pack('H*', $2);$start = [gettimeofday];
   undef($waitForPLM);
}elsif($in =~ m/$sent(15)$/){
   print ("PLM didn't understand command: $in\n");
   return(0);
}elsif($in =~m/(15)+/){
   print("PLM is busy ($in).  I'm waiting to retry the message.\n");
   return(1);
}
   }
}else{
   if($got){
my $length = do { use bytes; length($got) };
$in = unpack('H*', $got);
if($in =~ m/^0250/ and $length == 11){
   print("Received SD: $in\n");
   return(0);
   #We received a standard insteon message!
}elsif($in =~ m/^0251/ and $length == 25){
   print("Received ED: $in\n");
}
   }
}
if($duration > $wait and !$done){
$done = 1;
print "No response received! (got is: $in)\n";
}
    } while(!$done);
}
ċ
demo.pl
(5k)
Matthew R Chase,
Apr 16, 2010, 10:02 AM
Comments