diff --git a/fhem/CHANGED b/fhem/CHANGED index d9b7560d8..6cb859d9a 100644 --- a/fhem/CHANGED +++ b/fhem/CHANGED @@ -1,6 +1,7 @@ - CVS - bugfix: applying smallscreen attributes to firefox/opera - feature: CUL_TX added (thanks to Peterp) + - feature: TCM120 / EnOcean parser added - 2011-07-08 (5.1) - feature: smallscreen optimizations for iPhone diff --git a/fhem/FHEM/00_TCM120.pm b/fhem/FHEM/00_TCM120.pm new file mode 100755 index 000000000..01d206272 --- /dev/null +++ b/fhem/FHEM/00_TCM120.pm @@ -0,0 +1,574 @@ +############################################## +package main; + +# by r.koenig at koeniglich.de +# See also TCM_120_User_Manual_V1.53_02.pdf + +use strict; +use warnings; +use Time::HiRes qw(gettimeofday); + +sub TCM120_Read($); +sub TCM120_ReadAnswer($$); +sub TCM120_Ready($); +sub TCM120_Write($$$); + +sub TCM120_OpenDev($$); +sub TCM120_CloseDev($); +sub TCM120_SimpleWrite($$); +sub TCM120_SimpleRead($); +sub TCM120_Disconnected($); +sub TCM120_Parse($$$); + +sub +TCM120_Initialize($) +{ + my ($hash) = @_; + +# Provider + $hash->{ReadFn} = "TCM120_Read"; + $hash->{WriteFn} = "TCM120_Write"; + $hash->{ReadyFn} = "TCM120_Ready"; + +# Normal devices + $hash->{DefFn} = "TCM120_Define"; + $hash->{GetFn} = "TCM120_Get"; + $hash->{SetFn} = "TCM120_Set"; + $hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 loglevel:0,1,2,3,4,5,6 "; +} + +##################################### +sub +TCM120_Define($$) +{ + my ($hash, $def) = @_; + my @a = split("[ \t][ \t]*", $def); + + if(@a != 3) { + Log 1, "ARG:".int(@a); + my $msg = "wrong syntax: define TCM120 ". + "{devicename[\@baudrate]|ip:port}"; + return $msg; + } + + TCM120_CloseDev($hash); + + my $name = $a[0]; + my $dev = $a[2]; + + if($dev eq "none") { + Log 1, "$name device is none, commands will be echoed only"; + $attr{$name}{dummy} = 1; + return undef; + } + + $hash->{DeviceName} = $dev; + my $ret = TCM120_OpenDev($hash, 0); + return $ret; +} + + +##################################### +# Input is HEX, without header and CRC +sub +TCM120_Write($$$) +{ + my ($hash,$fn,$msg) = @_; + my $name = $hash->{NAME}; + my $ll5 = GetLogLevel($name,5); + + return if(!defined($fn)); + + Log $ll5, "$hash->{NAME} sending $fn$msg"; + my $bstring = "$fn$msg"; + $bstring = "A55A".$bstring.TCM120_CRC($bstring); + + TCM120_SimpleWrite($hash, $bstring); +} + +##################################### +sub +TCM120_CRC($) +{ + my $msg = shift; + my @data; + for(my $i = 0; $i < length($msg); $i += 2) { + push(@data, ord(pack('H*', substr($msg, $i, 2)))); + } + my $sum = 0; + map { $sum += $_; } @data; + return sprintf("%02X", $sum & 0xFF); +} + +##################################### +# called from the global loop, when the select for hash->{FD} reports data +sub +TCM120_Read($) +{ + my ($hash) = @_; + + my $buf = TCM120_SimpleRead($hash); + my $name = $hash->{NAME}; + my $ll5 = GetLogLevel($name,5); + + ########### + # Lets' try again: Some drivers return len(0) on the first read... + if(defined($buf) && length($buf) == 0) { + $buf = TCM120_SimpleRead($hash); + } + + if(!defined($buf) || length($buf) == 0) { + TCM120_Disconnected($hash); + return ""; + } + + my $data = $hash->{PARTIAL} . uc(unpack('H*', $buf)); + Log $ll5, "$name/RAW: $data"; + + if($data =~ m/^A55A(.B.{20})(..)/) { + my ($net, $crc) = ($1, $2); + my $mycrc = TCM120_CRC($net); + $hash->{PARTIAL} = substr($data, 28); + + if($crc ne $mycrc) { + Log $ll5, "$name: wrong checksum: got $crc, computed $mycrc" ; + return; + } + if($net =~ m/^0b/) { # Receive Radio Telegram (RRT) + Dispatch($hash, $net, undef); + } else { # Receive Message Telegram (RMT) + TCM120_Parse($hash, $net, 0); + } + + + } else { + if(length($data) >= 4) { + $data =~ s/.*A55A/A55A/ if($data !~ m/^A55A/); + $data = "" if($data !~ m/^A55A/); + } + $hash->{PARTIAL} = $data; + + } +} + +##################################### +my %parsetbl = ( + "8B08" => { msg=>"ERR_SYNTAX_H_SEQ" }, + "8B09" => { msg=>"ERR_SYNTAX_LENGTH" }, + "8B0A" => { msg=>"ERR_SYNTAX_CHKSUM" }, + "8B0B" => { msg=>"ERR_SYNTAX_ORG" }, + "8B0C" => { msg=>"ERR_MODEM_DUP_ID" }, + "8B19" => { msg=>"ERR" }, + "8B1A" => { msg=>"ERR_IDRANGE" }, + "8B22" => { msg=>"ERR_TX_IDRANGE" }, + "8B28" => { msg=>"ERR_MODEM_NOTWANTEDACK" }, + "8B29" => { msg=>"ERR_MODEM_NOTACK" }, + "8B58" => { msg=>"OK" }, + "8B8C" => { msg=>"INF_SW_VER", expr=>'"$a[2].$a[3].$a[4].$a[5]"' }, + "8B88" => { msg=>"INF_RX_SENSIVITY", expr=>'$a[2] ? "High (01)":"Low (00)"' }, + "8B89" => { msg=>"INFO", expr=>'substr($rawstr,2,9)' }, + "8B98" => { msg=>"INF_IDBASE", + expr=>'sprintf("%02x%02x%02x%02x", $a[2], $a[3], $a[4], $a[5])' }, + "8BA8" => { msg=>"INF_MODEM_STATUS", + expr=>'sprintf("%s, ID:%02x%02x", $a[2]?"on":"off", $a[3], $a[4])' }, +); + +sub +TCM120_Parse($$$) +{ + my ($hash,$rawmsg,$ret) = @_; + my $name = $hash->{NAME}; + my $ll5 = GetLogLevel($name,5); + my $ll2 = GetLogLevel($name,2); + + Log $ll5, "TCMParse: $rawmsg"; + + my $msg = ""; + my $cmd = $parsetbl{substr($rawmsg, 0, 4)}; + + if(!$cmd) { + $msg ="$name, Unknown command: $rawmsg"; + + } else { + if($cmd->{expr}) { + $msg = $cmd->{msg}." " if(!$ret); + my $rawstr = pack('H*', $rawmsg); + $rawstr =~ s/[\r\n]//g; + my @a = map { ord($_) } split("", $rawstr); + $msg .= eval $cmd->{expr}; + + } else { + $msg = $cmd->{msg}; + + } + + } + + Log $ll2, "$name $msg" if(!$ret); + return $msg; +} + +##################################### +sub +TCM120_Ready($) +{ + my ($hash) = @_; + + return TCM120_OpenDev($hash, 1) + if($hash->{STATE} eq "disconnected"); + + # This is relevant for windows/USB only + my $po = $hash->{USBDev}; + my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status; + return ($InBytes>0); +} + +######################## +# Input is HEX, with header and CRC +sub +TCM120_SimpleWrite($$) +{ + my ($hash, $msg) = @_; + return if(!$hash); + + $msg = pack('H*', $msg); + $hash->{USBDev}->write($msg) if($hash->{USBDev}); + syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev}); + select(undef, undef, undef, 0.001); +} + +######################## +sub +TCM120_SimpleRead($) +{ + my ($hash) = @_; + my $buf; + + $buf = $hash->{USBDev}->input() if($hash->{USBDev}); + $buf = sysread($hash->{TCPDev}, $buf, 256) if($hash->{TCPDev}); + return $buf; +} + +######################## +sub +TCM120_CloseDev($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; + my $dev = $hash->{DeviceName}; + + return if(!$dev); + + if($hash->{TCPDev}) { + $hash->{TCPDev}->close(); + delete($hash->{TCPDev}); + + } elsif($hash->{USBDev}) { + $hash->{USBDev}->close() ; + delete($hash->{USBDev}); + + } + + ($dev, undef) = split("@", $dev); # Remove the baudrate + delete($selectlist{"$name.$dev"}); + delete($readyfnlist{"$name.$dev"}); + delete($hash->{FD}); +} + +######################## +sub +TCM120_OpenDev($$) +{ + my ($hash, $reopen) = @_; + my $dev = $hash->{DeviceName}; + my $name = $hash->{NAME}; + my $po; + my $baudrate; + ($dev, $baudrate) = split("@", $dev); + + + $hash->{PARTIAL} = ""; + Log 3, "TCM120 opening $name device $dev" + if(!$reopen); + + if($dev =~ m/^(.+):([0-9]+)$/) { # host:port + + # This part is called every time the timeout (5sec) is expired _OR_ + # somebody is communicating over another TCP connection. As the connect + # for non-existent devices has a delay of 3 sec, we are sitting all the + # time in this connect. NEXT_OPEN tries to avoid this problem. + if($hash->{NEXT_OPEN} && time() < $hash->{NEXT_OPEN}) { + return; + } + + my $conn = IO::Socket::INET->new(PeerAddr => $dev); + if($conn) { + delete($hash->{NEXT_OPEN}) + + } else { + Log(3, "Can't connect to $dev: $!") if(!$reopen); + $readyfnlist{"$name.$dev"} = $hash; + $hash->{STATE} = "disconnected"; + $hash->{NEXT_OPEN} = time()+60; + return ""; + } + + $hash->{TCPDev} = $conn; + $hash->{FD} = $conn->fileno(); + delete($readyfnlist{"$name.$dev"}); + $selectlist{"$name.$dev"} = $hash; + + } else { # USB/Serial device + + if ($^O=~/Win/) { + require Win32::SerialPort; + $po = new Win32::SerialPort ($dev); + } else { + require Device::SerialPort; + $po = new Device::SerialPort ($dev); + } + + if(!$po) { + return undef if($reopen); + Log(3, "Can't open $dev: $!"); + $readyfnlist{"$name.$dev"} = $hash; + $hash->{STATE} = "disconnected"; + return ""; + } + $hash->{USBDev} = $po; + if( $^O =~ /Win/ ) { + $readyfnlist{"$name.$dev"} = $hash; + } else { + $hash->{FD} = $po->FILENO; + delete($readyfnlist{"$name.$dev"}); + $selectlist{"$name.$dev"} = $hash; + } + + if($baudrate) { + $po->reset_error(); + Log 3, "TCM120 setting $name baudrate to $baudrate"; + $po->baudrate($baudrate); + $po->databits(8); + $po->parity('none'); + $po->stopbits(1); + $po->handshake('none'); + + # 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; + } + + if($reopen) { + Log 1, "TCM120 $dev reappeared ($name)"; + } else { + Log 3, "TCM120 device opened"; + } + + $hash->{STATE}="connected"; + + DoTrigger($name, "CONNECTED") if($reopen); + return ""; +} + +sub +TCM120_Disconnected($) +{ + my $hash = shift; + my $dev = $hash->{DeviceName}; + my $name = $hash->{NAME}; + my $baudrate; + ($dev, $baudrate) = split("@", $dev); + + return if(!defined($hash->{FD})); # Already deleted or RFR + + Log 1, "$dev disconnected, waiting to reappear"; + TCM120_CloseDev($hash); + $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); + + DoTrigger($name, "DISCONNECTED"); +} + +my %gets = ( # Name, Data to send to the CUL, Regexp for the answer + "sensitivity" => "AB48", + "idbase" => "AB58", + "modem_status" => "AB68", + "sw_ver" => "AB4B", +); + +sub +TCM120_Get($@) +{ + my ($hash, @a) = @_; + my $name = $hash->{NAME}; + + return "\"get $name\" needs one parameter" if(@a != 2); + my $cmd = $a[1]; + my $rawcmd = $gets{$cmd}; + return "Unknown argument $cmd, choose one of " . join(" ", sort keys %gets) + if(!defined($rawcmd)); + + $rawcmd .= "000000000000000000"; + TCM120_Write($hash, "", $rawcmd); + + my ($err, $data) = TCM120_ReadAnswer($hash, "get $cmd"); + if($err) { + Log 1, $err; + return $err; + } + + if($data =~ m/^A55A(.B.{20})(..)/) { + my ($net, $crc) = ($1, $2); + my $mycrc = TCM120_CRC($net); + $hash->{PARTIAL} = substr($data, 28); + + if($crc ne $mycrc) { + return "wrong checksum: got $crc, computed $mycrc" ; + } + my $msg = TCM120_Parse($hash, $net, 1); + $hash->{READINGS}{$cmd}{VAL} = $msg; + $hash->{READINGS}{$cmd}{TIME} = TimeNow(); + return $msg; + + } else { + return "Bogus answer received"; + + } + +} + +my %sets = ( # Name, Data to send to the CUL, Regexp for the answer + "idbase" => { cmd=>"AB18", arg=>"[0-9A-F]{8}" }, + "sensitivity" => { cmd=>"AB08", arg=>"0[01]" }, + "sleep" => { cmd=>"AB09" }, + "wake" => { cmd=>"" }, # Special + "reset" => { cmd=>"AB0A" }, + "modem_on" => { cmd=>"AB28", arg=>"[0-9A-F]{4}" }, + "modem_off" => { cmd=>"AB2A" }, +); + +sub +TCM120_Set($@) +{ + my ($hash, @a) = @_; + my $name = $hash->{NAME}; + + return "\"set $name\" needs at least one parameter" if(@a < 2); + my $cmd = $a[1]; + my $arg = $a[2]; + my $cmdhash = $sets{$cmd}; + return "Unknown argument $cmd, choose one of " . join(" ", sort keys %sets) + if(!defined($cmdhash)); + + my $rawcmd = $cmdhash->{cmd}; + my $argre = $cmdhash->{arg}; + if($argre) { + return "Argument needed for set $name $cmd ($argre)" if(!defined($arg)); + return "Argument does not match the regexp ($argre)" if($arg !~ m/$argre/i); + $rawcmd .= $arg; + } + + if($rawcmd eq "") { # wake is very special + TCM120_SimpleWrite($hash, "AA"); + return ""; + } + + $rawcmd .= "0"x(22-length($rawcmd)); # Padding with 0 + TCM120_Write($hash, "", $rawcmd); + + my ($err, $data) = TCM120_ReadAnswer($hash, "get $cmd"); + if($err) { + Log 1, $err; + return $err; + } + + if($data =~ m/^A55A(.B.{20})(..)/) { + my ($net, $crc) = ($1, $2); + my $mycrc = TCM120_CRC($net); + $hash->{PARTIAL} = substr($data, 28); + + if($crc ne $mycrc) { + return "wrong checksum: got $crc, computed $mycrc" ; + } + my $msg = TCM120_Parse($hash, $net, 1); + $hash->{READINGS}{$cmd}{VAL} = $msg; + $hash->{READINGS}{$cmd}{TIME} = TimeNow(); + return $msg; + + } else { + return "Bogus answer received"; + + } + +} + + +sub +TCM120_ReadAnswer($$) +{ + my ($hash, $arg) = @_; + my $name = $hash->{NAME}; + my $ll5 = GetLogLevel($name,5); + + return ("No FD", undef) + if(!$hash || ($^O !~ /Win/ && !defined($hash->{FD}))); + + my ($data, $rin, $buf) = ("", "", ""); + my $to = 1; # 1 seconds timeout + while(length($data) < 28) { + if($^O =~ m/Win/ && $hash->{USBDev}) { + $hash->{USBDev}->read_const_time($to*1000); # set timeout (ms) + # Read anstatt input sonst funzt read_const_time nicht. + $buf = $hash->{USBDev}->read(999); + return ("$name Timeout reading answer for $arg", undef) + if(length($buf) == 0); + + } else { + return ("Device lost when reading answer for $arg", undef) + if(!$hash->{FD}); + + vec($rin, $hash->{FD}, 1) = 1; + my $nfound = select($rin, undef, undef, $to); + if($nfound < 0) { + next if ($! == EAGAIN() || $! == EINTR() || $! == 0); + my $err = $!; + TCM120_Disconnected($hash); + return("TCM120_ReadAnswer $err", undef); + } + return ("Timeout reading answer for $arg", undef) + if($nfound == 0); + $buf = TCM120_SimpleRead($hash); + return ("No data", undef) if(!defined($buf)); + + } + + if(defined($buf)) { + Log 5, "TCM120/RAW (ReadAnswer): $buf"; + $data .= uc(unpack('H*', $buf)); + } + } + return (undef, $data); + +} + +1; diff --git a/fhem/docs/commandref.html b/fhem/docs/commandref.html index 5e1c4f9f5..fe95e1399 100644 --- a/fhem/docs/commandref.html +++ b/fhem/docs/commandref.html @@ -114,6 +114,7 @@ SCIVT   SISPM   SIS_PMS   + TCM120   USF1000   USBWX   VantagePro2   @@ -5620,6 +5621,74 @@ Readings and STATE of temperature/humidity sensors are compatible with the CUL_W
+ +

TCM120

+ + +

weblink