From e3a879ac4dcc88287911b4a3c7f6cdc1974268ae Mon Sep 17 00:00:00 2001 From: rudolfkoenig <> Date: Sun, 7 Aug 2011 16:46:33 +0000 Subject: [PATCH] TCM310 added, with some EnOcean devices git-svn-id: https://svn.fhem.de/fhem/trunk@973 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/FHEM/00_TCM.pm | 810 ++++++++++++++++++++++++++++++++++++++++ fhem/FHEM/00_TCM120.pm | 580 ---------------------------- fhem/FHEM/10_EnOcean.pm | 50 ++- 3 files changed, 844 insertions(+), 596 deletions(-) create mode 100755 fhem/FHEM/00_TCM.pm delete mode 100755 fhem/FHEM/00_TCM120.pm diff --git a/fhem/FHEM/00_TCM.pm b/fhem/FHEM/00_TCM.pm new file mode 100755 index 000000000..c23de29a5 --- /dev/null +++ b/fhem/FHEM/00_TCM.pm @@ -0,0 +1,810 @@ +############################################## +package main; + +# by r.koenig at koeniglich.de +# +# This modules handles the communication with a TCM120 or TCM310 EnOcean +# transceiver chip. As the protocols are radically different, this is actually 2 +# drivers in one. +# See also: +# TCM_120_User_Manual_V1.53_02.pdf +# EnOcean Serial Protocol 3 (ESP3) (for the TCM310) + + +# TODO: +# Check BSC Temp +# Check Stick Temp +# Check Stick WriteRadio +# Check Stick RSS + +use strict; +use warnings; +use Time::HiRes qw(gettimeofday); + +sub TCM_Read($); +sub TCM_ReadAnswer($$); +sub TCM_Ready($); +sub TCM_Write($$$); + +sub TCM_OpenDev($$); +sub TCM_CloseDev($); +sub TCM_SimpleWrite($$); +sub TCM_SimpleRead($); +sub TCM_Disconnected($); +sub TCM_Parse120($$$); +sub TCM_CRC8($); +sub TCM_CSUM($); + +sub +TCM_Initialize($) +{ + my ($hash) = @_; + +# Provider + $hash->{ReadFn} = "TCM_Read"; + $hash->{WriteFn} = "TCM_Write"; + $hash->{ReadyFn} = "TCM_Ready"; + $hash->{Clients} = ":EnOcean:"; + my %matchList= ( + "1:EnOcean" => "^EnOcean:0B", + ); + $hash->{MatchList} = \%matchList; + +# Normal devices + $hash->{DefFn} = "TCM_Define"; + $hash->{GetFn} = "TCM_Get"; + $hash->{SetFn} = "TCM_Set"; + $hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 loglevel:0,1,2,3,4,5,6 "; +} + +##################################### +sub +TCM_Define($$) +{ + my ($hash, $def) = @_; + my @a = split("[ \t][ \t]*", $def); + my $name = $a[0]; + my $model = $a[2]; + + return "wrong syntax. Correct is: define TCM [120|310] ". + "{devicename[\@baudrate]|ip:port}" + if(@a != 4 || $model !~ m/^(120|310)$/); + + TCM_CloseDev($hash); + my $dev = $a[3]; + + if($dev eq "none") { + Log 1, "$name device is none, commands will be echoed only"; + $attr{$name}{dummy} = 1; + return undef; + } + + $hash->{DeviceName} = $dev; + $hash->{MODEL} = $model; + my $ret = TCM_OpenDev($hash, 0); + return $ret; +} + + +##################################### +# Input is HEX, without header and CRC +sub +TCM_Write($$$) +{ + my ($hash,$fn,$msg) = @_; + my $name = $hash->{NAME}; + my $ll5 = GetLogLevel($name,5); + + return if(!defined($fn)); + + my $bstring; + if($hash->{MODEL} eq "120") { + $bstring = "$fn$msg"; + $bstring = "A55A".$bstring.TCM_CSUM($bstring); + + } else { # 310 / ESP3 + if(!$fn) { # Radio Paket from the EnOcean Module + $msg =~ m/^6B05(..)000000(........)(..)$/; + # FIXME + } + + $bstring = sprintf("55%s%s%s%s", # $fn == Header, $msg == DATA + $fn, TCM_CRC8($fn), $msg, TCM_CRC8($msg)); + + } + Log $ll5, "$hash->{NAME} sending $bstring"; + + TCM_SimpleWrite($hash, $bstring); +} + +##################################### +# Used in the TCM120 / ESP2 +sub +TCM_CSUM($) +{ + my $msg = shift; + my $ml = length($msg); + + my @data; + for(my $i = 0; $i < $ml; $i += 2) { + push(@data, ord(pack('H*', substr($msg, $i, 2)))); + } + my $sum = 0; + map { $sum += $_; } @data; + return sprintf("%02X", $sum & 0xFF); +} + +##################################### +# Used in the TCM310 / ESP3 +my @u8CRC8Table = ( + 0x00, 0x07, 0x0e, 0x09, 0x1c, 0x1b, 0x12, 0x15, 0x38, 0x3f, 0x36, 0x31, 0x24, + 0x23, 0x2a, 0x2d, 0x70, 0x77, 0x7e, 0x79, 0x6c, 0x6b, 0x62, 0x65, 0x48, 0x4f, + 0x46, 0x41, 0x54, 0x53, 0x5a, 0x5d, 0xe0, 0xe7, 0xee, 0xe9, 0xfc, 0xfb, 0xf2, + 0xf5, 0xd8, 0xdf, 0xd6, 0xd1, 0xc4, 0xc3, 0xca, 0xcd, 0x90, 0x97, 0x9e, 0x99, + 0x8c, 0x8b, 0x82, 0x85, 0xa8, 0xaf, 0xa6, 0xa1, 0xb4, 0xb3, 0xba, 0xbd, 0xc7, + 0xc0, 0xc9, 0xce, 0xdb, 0xdc, 0xd5, 0xd2, 0xff, 0xf8, 0xf1, 0xf6, 0xe3, 0xe4, + 0xed, 0xea, 0xb7, 0xb0, 0xb9, 0xbe, 0xab, 0xac, 0xa5, 0xa2, 0x8f, 0x88, 0x81, + 0x86, 0x93, 0x94, 0x9d, 0x9a, 0x27, 0x20, 0x29, 0x2e, 0x3b, 0x3c, 0x35, 0x32, + 0x1f, 0x18, 0x11, 0x16, 0x03, 0x04, 0x0d, 0x0a, 0x57, 0x50, 0x59, 0x5e, 0x4b, + 0x4c, 0x45, 0x42, 0x6f, 0x68, 0x61, 0x66, 0x73, 0x74, 0x7d, 0x7a, 0x89, 0x8e, + 0x87, 0x80, 0x95, 0x92, 0x9b, 0x9c, 0xb1, 0xb6, 0xbf, 0xb8, 0xad, 0xaa, 0xa3, + 0xa4, 0xf9, 0xfe, 0xf7, 0xf0, 0xe5, 0xe2, 0xeb, 0xec, 0xc1, 0xc6, 0xcf, 0xc8, + 0xdd, 0xda, 0xd3, 0xd4, 0x69, 0x6e, 0x67, 0x60, 0x75, 0x72, 0x7b, 0x7c, 0x51, + 0x56, 0x5f, 0x58, 0x4d, 0x4a, 0x43, 0x44, 0x19, 0x1e, 0x17, 0x10, 0x05, 0x02, + 0x0b, 0x0c, 0x21, 0x26, 0x2f, 0x28, 0x3d, 0x3a, 0x33, 0x34, 0x4e, 0x49, 0x40, + 0x47, 0x52, 0x55, 0x5c, 0x5b, 0x76, 0x71, 0x78, 0x7f, 0x6A, 0x6d, 0x64, 0x63, + 0x3e, 0x39, 0x30, 0x37, 0x22, 0x25, 0x2c, 0x2b, 0x06, 0x01, 0x08, 0x0f, 0x1a, + 0x1d, 0x14, 0x13, 0xae, 0xa9, 0xa0, 0xa7, 0xb2, 0xb5, 0xbc, 0xbb, 0x96, 0x91, + 0x98, 0x9f, 0x8a, 0x8D, 0x84, 0x83, 0xde, 0xd9, 0xd0, 0xd7, 0xc2, 0xc5, 0xcc, + 0xcb, 0xe6, 0xe1, 0xe8, 0xef, 0xfa, 0xfd, 0xf4, 0xf3 ); + +sub +TCM_CRC8($) +{ + my $msg = shift; + my $ml = length($msg); + + my @data; + for(my $i = 0; $i < $ml; $i += 2) { + push(@data, ord(pack('H*', substr($msg, $i, 2)))); + } + my $crc = 0; + map { $crc = $u8CRC8Table[$crc ^ $_]; } @data; + return sprintf("%02X", $crc); +} + +##################################### +# called from the global loop, when the select for hash->{FD} reports data +sub +TCM_Read($) +{ + my ($hash) = @_; + + my $buf = TCM_SimpleRead($hash); + my $name = $hash->{NAME}; + my $ll5 = GetLogLevel($name,5); + my $ll2 = GetLogLevel($name,2); + + ########### + # Lets' try again: Some drivers return len(0) on the first read... + if(defined($buf) && length($buf) == 0) { + $buf = TCM_SimpleRead($hash); + } + + if(!defined($buf) || length($buf) == 0) { + TCM_Disconnected($hash); + return ""; + } + + my $data = $hash->{PARTIAL} . uc(unpack('H*', $buf)); + Log $ll5, "$name/RAW: $data"; + + ############################# + if($hash->{MODEL} == 120) { + if($data =~ m/^A55A(.B.{20})(..)/) { + my ($net, $crc) = ($1, $2); + my $mycrc = TCM_CSUM($net); + $hash->{PARTIAL} = substr($data, 28); + + if($crc ne $mycrc) { + Log $ll2, "$name: wrong checksum: got $crc, computed $mycrc" ; + return; + } + if($net =~ m/^0B/) { # Receive Radio Telegram (RRT) + Dispatch($hash, "EnOcean:$net", undef); + } else { # Receive Message Telegram (RMT) + TCM_Parse120($hash, $net, 0); + } + + + } else { + if(length($data) >= 4) { + $data =~ s/.*A55A/A55A/ if($data !~ m/^A55A/); + $data = "" if($data !~ m/^A55A/); + } + $hash->{PARTIAL} = $data; + + } + + ############################# + } else { # TCM310 / ESP3 + if($data =~ m/^55(....)(..)(..)(..)/) { + my ($l1, $l2, $t, $crc) = (hex($1), hex($2), $3, $4); + my $tlen = (7+$l1+$l2); + if(length($data) < 2*$tlen) { + $hash->{PARTIAL} = $data; + return; + } + $hash->{PARTIAL} = substr($data, ($tlen*2)); + + my $hdr = substr($data, 2, 8); + my $mdata = substr($data, 12, $l1*2); + my $odata = substr($data, 12+$l1*2, $l2*2); + + my $mycrc = TCM_CRC8($hdr); + if($mycrc ne $crc) { + Log $ll2, "$name: wrong header checksum: got $crc, computed $mycrc" ; + return; + } + $mycrc = TCM_CRC8($mdata . $odata); + $crc = substr($data, -2); + if($mycrc ne $crc) { + Log $ll2, "$name: wrong data checksum: got $crc, computed $mycrc" ; + return; + } + + if($t eq "01") { # Radio + my %orgmap = ("F6"=>"05", "D5"=>"06", "A5"=>"07", ); + $mdata =~ m/^(..)(.*)(........)(..)$/; + my $org = $orgmap{$1}; + Log 1, "TCM310: unknown ORG mapping for $1" if(!$org); + my $net = sprintf("0B%s%s%s%s%s", + $org ? $org:"00", $2, "0"x(8-length($2)), $3, $4); + $odata =~ m/^(..)(........)(..)(..)$/; + my %addvals = (SubTelNum => $1, DestinationID => $2, + RSSI => $3, SecurityLevel => $4,); + $hash->{RSSI} = $3; + + Dispatch($hash, "EnOcean:$net", \%addvals); + + } else { + Log $ll2, "$name: unknown packet type $t: $data" ; + + } + + + } else { + if(length($data) >= 4) { + $data =~ s/.*55/55/ if($data !~ m/^55/); + $data = "" if($data !~ m/^55/); + } + $hash->{PARTIAL} = $data; + + } + + + } +} + +##################################### +my %parsetbl120 = ( + "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 +TCM_Parse120($$$) +{ + 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 = $parsetbl120{substr($rawmsg, 0, 4)}; + + if(!$cmd) { + $msg ="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 { + return "" if($cmd ->{msg} eq "OK" && !$ret); # SKIP Ok + $msg = $cmd->{msg}; + + } + + } + + Log $ll2, "$name $msg" if(!$ret); + return $msg; +} + +my %rc310 = ( + "01" => "ERROR", + "02" => "NOT_SUPPORTED", + "03" => "WRONG_PARAM", + "04" => "OPERATION_DENIED", +); + +sub +TCM_Parse310($$$) +{ + my ($hash,$rawmsg,$ptr) = @_; + my $name = $hash->{NAME}; + my $ll5 = GetLogLevel($name,5); + my $ll2 = GetLogLevel($name,2); + + Log $ll5, "TCMParse: $rawmsg"; + + my $rc = substr($rawmsg, 0, 2); + my $msg; + + if($rc ne "00") { + my $msg = $rc310{$rc}; + $msg = "Unknown return code $rc" if(!$msg); + + } else { + my @ans; + foreach my $k (sort keys %{$ptr}) { + next if($k eq "cmd" || $k eq "arg"); + my ($off, $len, $type) = split(",", $ptr->{$k}); + my $data = substr($rawmsg, $off*2, $len*2); + $data = pack('H*', $data) if($type && $type eq "STR"); + push @ans, "$k=$data"; + } + $msg = join(",", @ans); + } + + Log $ll2, "$name $msg"; + return $msg; +} + + +##################################### +sub +TCM_Ready($) +{ + my ($hash) = @_; + + return TCM_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 +TCM_SimpleWrite($$) +{ + my ($hash, $msg) = @_; + return if(!$hash); + #Log 1, "SW: $msg"; + $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 +TCM_SimpleRead($) +{ + my ($hash) = @_; + my $buf; + + $buf = $hash->{USBDev}->input() if($hash->{USBDev}); + $buf = sysread($hash->{TCPDev}, $buf, 256) if($hash->{TCPDev}); + return $buf; +} + +######################## +sub +TCM_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 +TCM_OpenDev($$) +{ + my ($hash, $reopen) = @_; + my $dev = $hash->{DeviceName}; + my $name = $hash->{NAME}; + my $po; + my $baudrate; + ($dev, $baudrate) = split("@", $dev); + if(!$baudrate) { + $baudrate = 9600 if($hash->{MODEL} == 120); + $baudrate = 57600 if($hash->{MODEL} == 310); + } + + + $hash->{PARTIAL} = ""; + Log 3, "TCM 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; + } + + $po->reset_error(); + $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, "TCM $dev reappeared ($name)"; + } else { + Log 3, "TCM device opened"; + } + + $hash->{STATE}="connected"; + + DoTrigger($name, "CONNECTED") if($reopen); + return ""; +} + +sub +TCM_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"; + TCM_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 %gets120 = ( + "sensitivity" => "AB48", + "idbase" => "AB58", + "modem_status" => "AB68", + "sw_ver" => "AB4B", +); + +my %gets310 = ( + "sw_ver" => {cmd=>"03", + APPVersion => "1,4", + APIVersion => "5,4", + ChipID => "9,4", + ChipVersion => "13,4", + Desc => "17,16,STR", }, + "idbase" => {cmd=>"08", + BaseId => "1,4", + RemainingWriteCycles => "5,1",}, +); + + +sub +TCM_Get($@) +{ + my ($hash, @a) = @_; + my $name = $hash->{NAME}; + + return "\"get $name\" needs one parameter" if(@a != 2); + my $cmd = $a[1]; + my ($err, $msg); + + #################################### TCM120 + if($hash->{MODEL} eq "120") { + my $rawcmd = $gets120{$cmd}; + return "Unknown argument $cmd, choose one of " . + join(" ", sort keys %gets120) if(!defined($rawcmd)); + + $rawcmd .= "000000000000000000"; + TCM_Write($hash, "", $rawcmd); + + ($err, $msg) = TCM_ReadAnswer($hash, "get $cmd"); + $msg = TCM_Parse120($hash, $msg, 1) + if(!$err); + + #################################### TCM310 + } else { + my $cmdhash = $gets310{$cmd}; + return "Unknown argument $cmd, choose one of " . + join(" ", sort keys %gets310) if(!defined($cmdhash)); + + my $cmdHex = $cmdhash->{cmd}; + TCM_Write($hash, sprintf("%04X0005", length($cmdHex)/2), $cmdHex); + ($err, $msg) = TCM_ReadAnswer($hash, "get $cmd"); + $msg = TCM_Parse310($hash, $msg, $cmdhash) + if(!$err); + + } + + if($err) { + Log 1, $err; + return $err; + } + $hash->{READINGS}{$cmd}{VAL} = $msg; + $hash->{READINGS}{$cmd}{TIME} = TimeNow(); + return $msg; + +} + +my %sets120 = ( # Name, Data to send to the CUL, Regexp for the answer + "idbase" => { cmd=>"AB18", arg=>"FF[8-9A-F][0-9A-F]{5}" }, + "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" }, +); + +my %sets310 = ( + "idbase" => { cmd=>"07", arg=>"FF[8-9A-F][0-9A-F]{5}" }, +# The following 3 does not seem to work / dont get an answer +# "sleep" => { cmd=>"01", arg=>"00[0-9A-F]{6}" }, +# "reset" => { cmd=>"02" }, +# "bist" => { cmd=>"06", BIST_Result=>"1,1", }, +); + +sub +TCM_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 ($err, $msg); + + my $chash = ($hash->{MODEL} eq "120" ? \%sets120 : \%sets310); + my $cmdhash = $chash->{$cmd}; + return "Unknown argument $cmd, choose one of ".join(" ",sort keys %{$chash}) + if(!defined($cmdhash)); + + my $cmdHex = $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); + $cmdHex .= $arg; + } + + + ############################## + if($hash->{MODEL} eq "120") { + if($cmdHex eq "") { # wake is very special + TCM_SimpleWrite($hash, "AA"); + return ""; + } + + $cmdHex .= "0"x(22-length($cmdHex)); # Padding with 0 + TCM_Write($hash, "", $cmdHex); + ($err, $msg) = TCM_ReadAnswer($hash, "get $cmd"); + $msg = TCM_Parse120($hash, $msg, 1) + if(!$err); + + ############################## + } else { # TCM310 + TCM_Write($hash, sprintf("%04X0005", length($cmdHex)/2), $cmdHex); + ($err, $msg) = TCM_ReadAnswer($hash, "set $cmd"); + $msg = TCM_Parse310($hash, $msg, $cmdhash) + if(!$err); + + } + + if($err) { + Log 1, $err; + return $err; + } + return $msg; +} + + +sub +TCM_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 = 3; # 3 seconds timeout + for(;;) { + 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 = $!; + TCM_Disconnected($hash); + return("TCM_ReadAnswer $err", undef); + } + return ("Timeout reading answer for $arg", undef) + if($nfound == 0); + $buf = TCM_SimpleRead($hash); + return ("No data", undef) if(!defined($buf)); + + } + + if(defined($buf)) { + $data .= uc(unpack('H*', $buf)); + Log 5, "TCM/RAW (ReadAnswer): $data"; + + if($hash->{MODEL} eq "120") { + if(length($data) >= 28) { + return ("$arg: Bogus answer received: $data", undef) + if($data !~ m/^A55A(.B.{20})(..)/); + my ($net, $crc) = ($1, $2); + my $mycrc = TCM_CSUM($net); + $hash->{PARTIAL} = substr($data, 28); + + return ("wrong checksum: got $crc, computed $mycrc", undef) + if($crc ne $mycrc); + return (undef, $net); + } + + } else { # 310 + if(length($data) >= 7) { + return ("$arg: Bogus answer received: $data", undef) + if($data !~ m/^55(....)(..)(..)(..)(.*)(..)$/); + my ($dlen, $olen, $ptype, $hcrc, $data, $dcrc) = ($1,$2,$3,$4,$5,$6); + next if(length($data) < hex($dlen)+hex($olen)+6); + + my $myhcrc = TCM_CRC8("$dlen$olen$ptype"); + return ("wrong header checksum: got $hcrc, computed $myhcrc", undef) + if($hcrc ne $myhcrc); + + my $mydcrc = TCM_CRC8($data); + return ("wrong data checksum: got $dcrc, computed $mydcrc", undef) + if($dcrc ne $mydcrc); + return (undef, $data); + } + + } + } + } + +} + +1; diff --git a/fhem/FHEM/00_TCM120.pm b/fhem/FHEM/00_TCM120.pm deleted file mode 100755 index f6ecf5a36..000000000 --- a/fhem/FHEM/00_TCM120.pm +++ /dev/null @@ -1,580 +0,0 @@ -############################################## -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"; - $hash->{Clients} = ":EnOcean:"; - my %matchList= ( - "1:EnOcean" => "^EnOcean:0B", - ); - $hash->{MatchList} = \%matchList; - -# 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, "EnOcean:$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 ="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 { - return "" if($cmd ->{msg} eq "OK" && !$ret); # SKIP Ok - $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/FHEM/10_EnOcean.pm b/fhem/FHEM/10_EnOcean.pm index 42a67c67f..c4bcbdc50 100755 --- a/fhem/FHEM/10_EnOcean.pm +++ b/fhem/FHEM/10_EnOcean.pm @@ -25,7 +25,7 @@ EnOcean_Initialize($) $hash->{SetFn} = "EnOcean_Set"; $hash->{AttrList} = "IODev do_not_notify:1,0 ignore:0,1 " . "showtime:1,0 loglevel:0,1,2,3,4,5,6 model " . - "subType:remote,sensor,modem "; + "subType:remote,sensor,modem,windowHandle,contact,SR04PT "; } @@ -42,7 +42,7 @@ EnOcean_Define($$) $modules{EnOcean}{defptr}{uc($a[2])} = $hash; AssignIoPort($hash); - # Help FHEMWEB split up davices + # Help FHEMWEB split up devices $attr{$name}{subType} = $1 if($name =~ m/EnO_(.*)_$a[2]/); return undef; } @@ -109,6 +109,7 @@ EnOcean_Parse($$) } my $name = $hash->{NAME}; + my $st = AttrVal($name, "subType", ""); my $ll4 = GetLogLevel($name, 4); Log $ll4, "EnOcean: ORG:$org, DATA:$data, ID:$id, STATUS:$status"; my @event; @@ -116,7 +117,6 @@ EnOcean_Parse($$) push @event, "0:rp_counter:".(hex($status)&0xf); my $d1 = hex substr($data,0,2); - ################################# if($org eq "05") { # PTM remote. Queer reporting methods. my $nu = ((hex($status)&0x10)>>4); @@ -127,35 +127,53 @@ EnOcean_Parse($$) if($nu) { $msg = sprintf "Btn%d", ($d1&0xe0)>>5; $msg .= sprintf ",Btn%d", ($d1&0x0e)>>1 if($d1 & 1); + $msg .= ($d1&0x10) ? " pressed" : " released"; } else { #confusing for normal use #my $nbu = (($d1&0xe0)>>5); #$msg = sprintf "Buttons %d", $nbu ? ($nbu+1) : 0; - $msg = "buttons"; + $msg = "buttons " . ($d1&0x10 ? "pressed" : "released"); + + if($st eq "windowHandle") { + $msg = "closed" if($d1 == 0xF0); + $msg = "open" if($d1 == 0xE0); + $msg = "tilted" if($d1 == 0xD0); + $msg = "open from tilted" if($d1 == 0xC0); + } } - $msg .= ($d1&0x10) ? " pressed" : " released"; push @event, "1:state:$msg"; ################################# } elsif($org eq "06") { - push @event, "1:state:$d1"; - push @event, "1:sensor1:$d1"; + if($st eq "contact") { + push @event, "1:state:" . ($d1 == 9 ? "closed" : "open"); + + } else { + push @event, "1:state:sensor:$d1"; + push @event, "1:sensor:$d1"; + } ################################# } elsif($org eq "07") { my $d2 = hex substr($data,2,2); my $d3 = hex substr($data,4,2); my $d4 = hex substr($data,6,2); - push @event, "1:state:$d1"; - push @event, "1:sensor1:$d1"; - push @event, "1:sensor2:$d2"; - push @event, "1:sensor3:$d3"; - push @event, "1:D3:".($d4&0x8)?1:0; - push @event, "1:D2:".($d4&0x4)?1:0; - push @event, "1:D1:".($d4&0x2)?1:0; - push @event, "1:D0:".($d4&0x1)?1:0; + if($st eq "SR04PT") { + push @event, "1:state:alive"; + push @event, "1:present:".(($d4&0x1)?"No":"Yes"); + push @event, "1:desired:$d1"; + } else { + push @event, "1:state:$d1"; + push @event, "1:sensor1:$d1"; + push @event, "1:sensor2:$d2"; + push @event, "1:sensor3:$d3"; + push @event, "1:D3:".(($d4&0x8)?1:0); + push @event, "1:D2:".(($d4&0x4)?1:0); + push @event, "1:D1:".(($d4&0x2)?1:0); + push @event, "1:D0:".(($d4&0x1)?1:0); + } ################################# } elsif($org eq "08") { # CTM remote. @@ -172,13 +190,13 @@ EnOcean_Parse($$) } elsif($org eq "0B") { push @event, "1:state:Modem:ACK"; + } elsif($org eq "00") { } my $tn = TimeNow(); my @changed; for(my $i = 0; $i < int(@event); $i++) { my ($dochanged, $vn, $vv) = split(":", $event[$i], 3); - if($dochanged) { if($vn eq "state") { $hash->{STATE} = $vv;