mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-04-08 19:32:42 +00:00
TCM310 added, with some EnOcean devices
git-svn-id: https://svn.fhem.de/fhem/trunk@973 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig
parent
4a90d23227
commit
e3a879ac4d
810
fhem/FHEM/00_TCM.pm
Executable file
810
fhem/FHEM/00_TCM.pm
Executable file
@ -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 <name> 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;
|
||||
@ -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 <name> 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;
|
||||
@ -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;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user