Start with some basic declarations. #!/usr/bin/perluse 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/ttyUSB0my $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 minutestty_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: |
Insteon >
