################################################################ # # Copyright notice # # (c) 2008 Dr. Boris Neubert (omega@online.de) # # This script is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # The GNU General Public License can be found at # http://www.gnu.org/copyleft/gpl.html. # A copy is found in the textfile GPL.txt and important notices to the license # from the author is found in LICENSE.txt distributed with these scripts. # # This script is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # This copyright notice MUST APPEAR in all copies of the script! # ################################################################ # $Id$ package main; use strict; use warnings; use Time::HiRes qw(gettimeofday); sub CM11_Write($$$); sub CM11_Read($); sub CM11_Ready($$); my $msg_pollpc = pack("H*", "5a"); # interface poll signal (CM11->PC) my $msg_pollpcpf = pack("H*", "a5"); # power fail poll signal (CM11->PC) my $msg_pollack = pack("H*", "c3"); # response to poll signal (PC->CM11) my $msg_pollackpf= pack("H*", "fb"); # response to power fail poll signal (PC->CM11) my $msg_txok = pack("H*", "00"); # OK for transmission (PC->CM11) my $msg_ifrdy = pack("H*", "55"); # interface ready (CM11->PC) my $msg_statusrq = pack("H*", "8b"); # status request (PC->CM11) my %housecodes_rcv = qw(0110 A 1110 B 0010 C 1010 D 0001 E 1001 F 0101 G 1101 H 0111 I 1111 J 0011 K 1011 L 0000 M 1000 N 0100 O 1100 P); my %unitcodes_rcv = qw(0110 1 1110 2 0010 3 1010 4 0001 5 1001 6 0101 7 1101 8 0111 9 1111 10 0011 11 1011 12 0000 13 1000 14 0100 15 1100 16); my %functions_rcv = qw(0000 ALL_UNITS_OFF 0001 ALL_LIGHTS_ON 0010 ON 0011 OFF 0100 DIM 0101 BRIGHT 0110 ALL_LIGHTS_OFF 0111 EXTENDED_CODE 1000 HAIL_REQUEST 1001 HAIL_ACK 1010 PRESET_DIM1 1011 PRESET_DIM2 1100 EXTENDED_DATA_TRANSFER 1101 STATUS_ON 1110 STATUS_OFF 1111 STATUS_REQUEST); my %gets = ( "fwrev" => "xxx", "time" => "xxx", ); my %sets = ( "reopen" => "xxx", ); ##################################### sub CM11_Initialize($) { my ($hash) = @_; # Provider $hash->{ReadFn} = "CM11_Read"; $hash->{WriteFn} = "CM11_Write"; $hash->{Clients} = ":X10:"; $hash->{ReadyFn} = "CM11_Ready"; # Normal Device $hash->{DefFn} = "CM11_Define"; $hash->{UndefFn} = "CM11_Undef"; $hash->{GetFn} = "CM11_Get"; $hash->{SetFn} = "CM11_Set"; $hash->{StateFn} = "CM11_SetState"; $hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 " . "model:CM11"; } ##################################### sub CM11_DoInit($$$) { my ($name,$type,$po) = @_; my @init; $po->reset_error(); $po->baudrate(4800); $po->databits(8); $po->parity('none'); $po->stopbits(1); $po->handshake('none'); if($type && $type eq "strangetty") { # This part is for some Linux kernel versions whih has strange default # settings. Device::SerialPort is nice: if the flag is not defined for your # OS then it will be ignored. $po->stty_icanon(0); #$po->stty_parmrk(0); # The debian standard install does not have it $po->stty_icrnl(0); $po->stty_echoe(0); $po->stty_echok(0); $po->stty_echoctl(0); # Needed for some strange distros $po->stty_echo(0); $po->stty_icanon(0); $po->stty_isig(0); $po->stty_opost(0); $po->stty_icrnl(0); } $po->write_settings; $defs{$name}{STATE} = "Initialized"; } ##################################### sub CM11_Reopen($) { my ($hash) = @_; my $name = $hash->{NAME}; my $dev = $hash->{DeviceName}; $hash->{PortObj}->close(); Log3($name, 1, "Device $dev closed"); for(;;) { sleep(5); if($^O =~ m/Win/) { $hash->{PortObj} = new Win32::SerialPort($dev); }else{ $hash->{PortObj} = new Device::SerialPort($dev); } if($hash->{PortObj}) { Log3($name, 1, "Device $dev reopened"); $hash->{FD} = $hash->{PortObj}->FILENO if($^O !~ m/Win/); CM11_DoInit($hash->{NAME}, $hash->{ttytype}, $hash->{PortObj}); return; } } } ##################################### sub CM11_Define($$) { my ($hash, $def) = @_; my @a = split("[ \t][ \t]*", $def); my $po; return "wrong syntax: define CM11 devicename ". "[normal|strangetty] [mobile]" if(@a < 3 || @a > 5); delete $hash->{PortObj}; delete $hash->{FD}; my $name = $a[0]; my $dev = $a[2]; $hash->{ttytype} = $a[3] if($a[3]); $hash->{MOBILE} = 1 if($a[4] && $a[4] eq "mobile"); $hash->{STATE} = "defined"; if($dev eq "none") { Log3($name, 1, "CM11 device is none, commands will be echoed only"); $attr{$name}{dummy} = 1; return undef; } $hash->{DeviceName} = $dev; $hash->{PARTIAL} = ""; Log3($name, 3, "CM11 opening CM11 device $dev"); if ($^O=~/Win/) { require Win32::SerialPort; $po = new Win32::SerialPort ($dev); } else { require Device::SerialPort; $po = new Device::SerialPort ($dev); } if(!$po) { my $msg = "Can't open $dev: $!"; Log3($name, 3, $msg) if($hash->{MOBILE}); return $msg if(!$hash->{MOBILE}); $readyfnlist{"$name.$dev"} = $hash; return ""; } Log3($name, 3, "CM11 opened CM11 device $dev"); $hash->{PortObj} = $po; if( $^O !~ /Win/ ) { $hash->{FD} = $po->FILENO; $selectlist{"$name.$dev"} = $hash; } else { $readyfnlist{"$name.$dev"} = $hash; } CM11_DoInit($name, $hash->{ttytype}, $po); #CM11_SetInterfaceTime($hash); #CM11_GetInterfaceStatus($hash); return undef; } ##################################### sub CM11_Undef($$) { my ($hash, $arg) = @_; my $name = $hash->{NAME}; foreach my $d (sort keys %defs) { if(defined($defs{$d}) && defined($defs{$d}{IODev}) && $defs{$d}{IODev} == $hash) { my $lev = ($reread_active ? 4 : 2); Log3($name, $lev, "deleting port for $d"); delete $defs{$d}{IODev}; } } $hash->{PortObj}->close() if($hash->{PortObj}); return undef; } ##################################### sub CM11_SetState($$$$) { my ($hash, $tim, $vt, $val) = @_; return undef; } ##################################### sub CM11_LogReadWrite($@) { my ($rw,$hash, $msg, $trlr) = @_; my $name= $hash->{NAME}; Log3($name, 5, "CM11 device " . $name . ": $rw " . sprintf("%2d: ", length($msg)) . unpack("H*", $msg)); } sub CM11_LogRead(@) { CM11_LogReadWrite("read ", @_); } sub CM11_LogWrite(@) { CM11_LogReadWrite("write", @_); } ##################################### sub CM11_SimpleWrite($$) { my ($hash, $msg) = @_; return if(!$hash || !defined($hash->{PortObj})); CM11_LogWrite($hash,$msg); $hash->{PortObj}->write($msg); } ##################################### sub CM11_ReadDirect($$) { # This is a direct read for CM11_Write my ($hash,$arg) = @_; return undef if(!$hash || !defined($hash->{FD})); my $name= $hash->{NAME}; my $prefix= "CM11 device " . $name . ":"; my $rin= ''; my $nfound; if($^O eq 'MSWin32') { $nfound= CM11_Ready($hash, undef); } else { vec($rin, $hash->{FD}, 1) = 1; my $to = 20; # seconds timeout (response might be damn slow) $to = $hash->{RA_Timeout} if($hash->{RA_Timeout}); # ...or less $nfound = select($rin, undef, undef, $to); if($nfound < 0) { next if ($! == EAGAIN() || $! == EINTR() || $! == 0); Log3($name, 3, "$prefix Select error $nfound / $!"); return undef; } } if(!$nfound) { Log3($name, 3, "$prefix Timeout reading $arg"); return undef; } my $buf = $hash->{PortObj}->input(); CM11_LogRead($hash,$buf); return $buf; } ##################################### sub CM11_Write($$$) { # send two bytes, verify checksum, send ok my ($hash,$b1,$b2) = @_; my $name = $hash->{NAME}; my $prefix= "CM11 device $name:"; if(!$hash || !defined($hash->{PortObj})) { Log3($name, 3, "$prefix device is not active, cannot send"); return; } # checksum my $b1d = unpack('C', $b1); my $b2d = unpack('C', $b2); my $checksum_w = ($b1d + $b2d) & 0xff; my $data; # try 5 times to send my $try= 5; for(;;) { $try--; # send two bytes $data= $b1 . $b2; CM11_LogWrite($hash,$data); $hash->{PortObj}->write($data); # get checksum my $checksum= CM11_ReadDirect($hash, "checksum"); return 0 if(!defined($checksum)); # read failure my $checksum_r= unpack('C', $checksum); if($checksum_w ne $checksum_r) { Log3($name, 5, "$prefix wrong checksum (send: $checksum_w, received: $checksum_r)"); return 0 if(!$try); my $nexttry= 6-$try; Log3($name, 5, "$prefix retrying (" . $nexttry . "/5)"); } else { Log3($name, 5, "$prefix checksum correct, OK for transmission"); last; } } # checksum ok => send OK for transmission $data= $msg_txok; CM11_LogWrite($hash,$data); $hash->{PortObj}->write($data); my $ready= CM11_ReadDirect($hash, "ready"); return 0 if(!defined($ready)); # read failure if($ready ne $msg_ifrdy) { Log3($name, 3, "$prefix strange ready signal (" . unpack('C', $ready) . ")"); return 0 } else { Log3($name, 5, "$prefix ready"); } # we are fine return 1; } ##################################### sub CM11_GetInterfaceStatus($) { my ($hash)= @_; CM11_SimpleWrite($hash, $msg_statusrq); my $statusmsg= ""; while(length($statusmsg)<14) { my $buf= CM11_ReadDirect($hash, "status"); return if(!defined($buf)); # read error $statusmsg.= $buf; } return $statusmsg; } ##################################### sub CM11_Get($@) { my ($hash, @a) = @_; return "CM11: get needs only one parameter" if(@a != 2); return "Unknown argument $a[1], choose one of " . join(" ", sort keys %gets) if(!defined($gets{$a[1]})); my ($fn, $arg) = split(" ", $gets{$a[1]}); my $v = join(" ", @a); my $name = $hash->{NAME}; Log3($name, 2, "CM11 get $v"); my $statusmsg= CM11_GetInterfaceStatus($hash); if(!defined($statusmsg)) { $v= "error"; Log3($name, 2, "CM11 error, device is irresponsive.") } else { my $msg= unpack("H*", $statusmsg); Log3($name, 5, "CM11 got ". $msg); if($a[1] eq "fwrev") { $v = hex(substr($msg, 14, 1)); } elsif($a[1] eq "time") { my $sec= hex(substr($msg, 4, 2)); my $hour= hex(substr($msg, 8, 2))*2; my $min= hex(substr($msg, 6, 2)); if($min>59) { $min-= 60; $hour++; } my $day= hex(substr($msg, 10, 2)); $day+= 256 if(hex(substr($msg, 12, 1)) & 0xf); $v= sprintf("%d.%02d:%02d:%02d", $day,$hour,$min,$sec); } } $hash->{READINGS}{$a[1]}{VAL} = $v; $hash->{READINGS}{$a[1]}{TIME} = TimeNow(); return "$a[0] $a[1] => $v"; } ##################################### sub CM11_Set($@) { my ($hash, @a) = @_; return "CM11: set needs one parameter" if(@a != 2); return "Unknown argument $a[1], choose one of " . join(" ", sort keys %sets) if(!defined($sets{$a[1]})); my ($fn, $arg) = split(" ", $sets{$a[1]}); my $v = join(" ", @a); my $name = $hash->{NAME}; Log3($name, 2, "CM11 set $v"); if($a[1] eq "reopen") { CM11_Reopen($hash); } return undef; } ##################################### sub CM11_SetInterfaceTime($) { my ($hash)= @_; # 7 Bytes, Bits 0..55 are # 55 to 48 timer download header (0x9b) # 47 to 40 Current time (seconds) # 39 to 32 Current time (minutes ranging from 0 to 119) # 31 to 23 Current time (hours/2, ranging from 0 to 11) # 23 to 16 Current year day (bits 0 to 7) # 15 Current year day (bit 8) # 14 to 8 Day mask (SMTWTFS) # 7 to 4 Monitored house code # 3 Reserved # 2 Battery timer clear flag # 1 Monitored status clear flag # 0 Timer purge flag # make the interface happy (time is set to zero) my $data = pack('C7', 0x9b,0x00,0x00,0x00,0x00,0x00,0x03); CM11_SimpleWrite($hash, $data); # get checksum (ignored) my $checksum= CM11_ReadDirect($hash, "checksum"); return 0 if(!defined($checksum)); # read failure # tx OK CM11_SimpleWrite($hash, $msg_txok); # get ready (ignored) my $ready= CM11_ReadDirect($hash, "ready"); return 0 if(!defined($ready)); # read failure return 1; } ##################################### sub CM11_Read($) { # # prolog # my ($hash) = @_; my $buf = $hash->{PortObj}->input(); my $name = $hash->{NAME}; # prefix for logging my $prefix= "CM11 device " . $name . ":"; # Lets' try again: Some drivers return len(0) on the first read... if(defined($buf) && length($buf) == 0) { $buf = $hash->{PortObj}->input(); } # USB troubleshooting if(!defined($buf) || length($buf) == 0) { my $dev = $hash->{DeviceName}; Log3($name, 1, "USB device $dev disconnected, waiting to reappear"); $hash->{PortObj}->close(); DoTrigger($name, "DISCONNECTED"); delete($hash->{PortObj}); delete($selectlist{"$name.$dev"}); $readyfnlist{"$name.$dev"} = $hash; # Start polling $hash->{STATE} = "disconnected"; # Without the following sleep the open of the device causes a SIGSEGV, # and following opens block infinitely. Only a reboot helps. sleep(5); } # # begin of message digesting # # concatenate yet unparsed message and newly received data my $x10data = $hash->{PARTIAL} . $buf; CM11_LogRead($hash,$buf); Log3($name, 5, "$prefix Data: " . unpack('H*',$x10data)); # normally the while loop will run only once while(length($x10data) > 0) { # we cut off everything before the latest poll signal my $p= index(reverse($x10data), $msg_pollpc); if($p<0) { $p= index(reverse($x10data), $msg_pollpcpf); } if($p>=0) { $x10data= substr($x10data, -$p-1); } # to start with, a single 0x5a is received if( substr($x10data,0,1) eq $msg_pollpc ) { # CM11 polls PC Log3($name, 5, "$prefix start of message"); CM11_SimpleWrite($hash, $msg_pollack); # PC ready $x10data= substr($x10data,1); # $x10data now empty next; } # experimental code follows #if( substr($x10data,0,2) eq pack("H*", "98e6") ) { # CM11 polls PC # Log 5, "$prefix 98e6"; # CM11_SimpleWrite($hash, $msg_pollack); # PC ready # $x10data= ""; # next; #} #if( substr($x10data,0,1) eq pack("H*", "98") ) { # CM11 polls PC # Log 5, "$prefix 98"; # next; #} # a single 0xa5 is a power-fail macro download poll if( substr($x10data,0,1) eq $msg_pollpcpf ) { # CM11 polls PC Log3($name, 5, "$prefix power-fail poll"); # the documentation wrongly says that the macros should be downloaded # in fact, the time must be set! if(CM11_SetInterfaceTime($hash)) { Log3($name, 5, "$prefix power-fail poll satisfied"); } else { Log3($name, 5, "$prefix power-fail poll satisfaction failed"); } $x10data= substr($x10data,1); # $x10data now empty next; } # a single 0x55 is a leftover from a failed transmission if( substr($x10data,0,1) eq $msg_ifrdy ) { # CM11 polls PC Log3($name, 5, "$prefix skipping leftover ready signal"); $x10data= substr($x10data,1); next; } # the message comes in small chunks of 1 or few bytes instead of the # whole buffer at once my $len= ord(substr($x10data,0,1))-1; # upload buffer size last if(length($x10data)< $len+2); # wait for complete msg # message is now complete, start interpretation # mask: Bits 0 (LSB)..7 (MSB) correspond to data bytes 0..7 # bit= 0: unitcode, bit= 1: function my $mask= unpack('B8', substr($x10data,1,1)); $x10data= substr($x10data,2); # cut off length and mask # $x10data now contains $len data bytes my $databytes= unpack('H*', substr($x10data,0)); Log3($name, 5, "$prefix message complete " . "(length $len, mask $mask, data $databytes)"); # the following lines decode the messages into unitcodes and functions # in general we have 0..n unitcodes followed by 1..m functions in the # message my $i= 0; my $dmsg= ""; while($i< $len) { my $data= substr($x10data, $i); my $bits = unpack('B8', $data); my $nibble_hi = substr($bits, 0, 4); my $nibble_lo = substr($bits, 4, 4); my $housecode= $housecodes_rcv{$nibble_hi}; # one hash for unitcodes X_UNIT and one hash for functions # X_FUNC is maintained per housecode X= A..P my $housecode_unit= $housecode . "_UNIT"; my $housecode_func= $housecode . "_FUNC"; my $isfunc= (substr($mask, -$i-1, 1)); if($isfunc) { # data byte is function my $x10func= $functions_rcv{$nibble_lo}; if(($x10func eq "DIM") || ($x10func eq "BRIGHT")) { my $level= ord(substr($x10data, ++$i)); $x10func.= " $level"; } elsif($x10func eq "EXTENDED_DATA_TRANSFER") { $data= substr($x10data, 2+(++$i)); my $command= substr($x10data, ++$i); $x10func.= unpack("H*", $data) . ":" . unpack("H*", $command); } $hash->{$housecode_func}= $x10func; Log3($name, 5, "$prefix $housecode_func: " . $hash->{$housecode_func}); # dispatch message to clients my $hu = $hash->{$housecode_unit}; $hu= "" unless(defined($hu)); my $hf = $hash->{$housecode_func}; my $dmsg= "X10:$housecode;$hu;$hf"; Dispatch($hash, $dmsg, undef); } else { # data byte is unitcode # if a command was executed before, clear unitcode list if(defined($hash->{$housecode_func})) { undef $hash->{$housecode_unit}; undef $hash->{$housecode_func}; } # get unitcode of unitcode my $unitcode= $unitcodes_rcv{$nibble_lo}; # append to list of unitcodes my $unitcodes= $hash->{$housecode_unit}; if(defined($hash->{$housecode_unit})) { $unitcodes= $hash->{$housecode_unit} . " "; } else { $unitcodes= ""; } $hash->{$housecode_unit}= "$unitcodes$unitcode"; Log3($name, 5, "$prefix $housecode_unit: " . $hash->{$housecode_unit}); } $i++; } $x10data= ''; } $hash->{PARTIAL} = $x10data; } ##################################### sub CM11_Ready($$) { my ($hash, $dev) = @_; my $po=$hash->{PortObj}; if(!$po) { # Looking for the device my $dev = $hash->{DeviceName}; my $name = $hash->{NAME}; $hash->{PARTIAL} = ""; if ($^O=~/Win/) { $po = new Win32::SerialPort ($dev); } else { $po = new Device::SerialPort ($dev); } return undef if(!$po); Log3($name, 1, "USB device $dev reappeared"); $hash->{PortObj} = $po; if( $^O !~ /Win/ ) { $hash->{FD} = $po->FILENO; delete($readyfnlist{"$name.$dev"}); $selectlist{"$name.$dev"} = $hash; } else { $readyfnlist{"$name.$dev"} = $hash; } CM11_DoInit($name, $hash->{ttytype}, $po); DoTrigger($name, "CONNECTED"); return undef; } # This is relevant for windows only return undef if !$po; my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status; return ($InBytes>0); } 1; =pod =item summary CM11 PC interface to receive and send X10 messages =item summary_DE CM11 PC Interface zum Empfangen und Senden von X10 =begin html

CM11

=end html =cut