mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-05-01 20:20:10 +00:00
484 lines
11 KiB
Perl
Executable File
484 lines
11 KiB
Perl
Executable File
##############################################
|
|
# Implemented:
|
|
# - Transmit limit trigger: Fire if more then 1% airtime
|
|
# is used in the last hour
|
|
# - reconnect
|
|
# - message flow control (send one F message every 0.25 seconds)
|
|
# - repeater/filtertimeout
|
|
# - FS20 rcv
|
|
# - FS20 xmit
|
|
# - FHT rcv
|
|
|
|
# TODO:
|
|
# - FHT xmit
|
|
# - HMS rcv
|
|
# - KS300 rcv
|
|
# - EMEM rcv
|
|
# - EMWZ rcv
|
|
# - EMGZ rcv
|
|
# - S300TH rcv
|
|
|
|
|
|
package main;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Time::HiRes qw(gettimeofday);
|
|
|
|
|
|
sub CUL_Write($$$);
|
|
sub CUL_Read($);
|
|
sub CUL_ReadAnswer($$);
|
|
sub CUL_Ready($$);
|
|
|
|
my %msghist; # Used when more than one CUL is attached
|
|
my $msgcount = 0;
|
|
my %gets = (
|
|
"ccreg" => "C",
|
|
"version" => "V",
|
|
);
|
|
|
|
sub
|
|
CUL_Initialize($)
|
|
{
|
|
my ($hash) = @_;
|
|
|
|
# Provider
|
|
$hash->{ReadFn} = "CUL_Read";
|
|
$hash->{WriteFn} = "CUL_Write";
|
|
$hash->{Clients} = ":CUL:FS20:FHT:";
|
|
$hash->{ReadyFn} = "CUL_Ready" if ($^O eq 'MSWin32');
|
|
|
|
# Normal devices
|
|
$hash->{DefFn} = "CUL_Define";
|
|
$hash->{UndefFn} = "CUL_Undef";
|
|
$hash->{GetFn} = "CUL_Get";
|
|
$hash->{SetFn} = "CUL_Set";
|
|
$hash->{StateFn} = "CUL_SetState";
|
|
$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 filtertimeout repeater:1,0 " .
|
|
"showtime:1,0 model:CUL loglevel:0,1,2,3,4,5,6";
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
CUL_Define($$)
|
|
{
|
|
my ($hash, $def) = @_;
|
|
my @a = split("[ \t][ \t]*", $def);
|
|
my $po;
|
|
$hash->{STATE} = "Initialized";
|
|
|
|
delete $hash->{PortObj};
|
|
delete $hash->{FD};
|
|
|
|
my $name = $a[0];
|
|
my $dev = $a[2];
|
|
|
|
$attr{$name}{savefirst} = 1;
|
|
$attr{$name}{repeater} = 1;
|
|
|
|
if($dev eq "none") {
|
|
Log 1, "CUL device is none, commands will be echoed only";
|
|
$attr{$name}{dummy} = 1;
|
|
return undef;
|
|
}
|
|
|
|
Log 3, "CUL opening CUL device $dev";
|
|
if ($^O=~/Win/) {
|
|
require Win32::SerialPort;
|
|
$po = new Win32::SerialPort ($dev);
|
|
} else {
|
|
require Device::SerialPort;
|
|
$po = new Device::SerialPort ($dev);
|
|
}
|
|
return "Can't open $dev: $!\n" if(!$po);
|
|
Log 3, "CUL opened CUL device $dev";
|
|
|
|
$hash->{PortObj} = $po;
|
|
$hash->{FD} = $po->FILENO if !( $^O =~ /Win/ );
|
|
|
|
$hash->{DeviceName} = $dev;
|
|
$hash->{PARTIAL} = "";
|
|
return CUL_DoInit($hash);
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
CUL_Undef($$)
|
|
{
|
|
my ($hash, $arg) = @_;
|
|
my $name = $hash->{NAME};
|
|
|
|
foreach my $d (sort keys %defs) {
|
|
if(defined($defs{$d}) &&
|
|
defined($defs{$d}{IODev}) &&
|
|
$defs{$d}{IODev} == $hash)
|
|
{
|
|
Log GetLogLevel($name,2), "deleting port for $d";
|
|
delete $defs{$d}{IODev};
|
|
}
|
|
}
|
|
$hash->{PortObj}->close() if($hash->{PortObj});
|
|
return undef;
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
CUL_Set($@)
|
|
{
|
|
my ($hash, @a) = @_;
|
|
return "NYI";
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
CUL_Get($@)
|
|
{
|
|
my ($hash, @a) = @_;
|
|
|
|
return "\"get CUL\" needs at leass one parameter" if(@a < 2);
|
|
return "Unknown argument $a[1], choose one of " . join(",", sort keys %gets)
|
|
if(!defined($gets{$a[1]}));
|
|
|
|
my $arg = ($a[2] ? $a[2] : "");
|
|
CUL_Write($hash, $gets{$a[1]}, $arg) if(!IsDummy($hash->{NAME}));
|
|
my $msg = CUL_ReadAnswer($hash, $a[1]);
|
|
$msg =~ s/[\r\n]//g;
|
|
|
|
$hash->{READINGS}{$a[1]}{VAL} = $msg;
|
|
$hash->{READINGS}{$a[1]}{TIME} = TimeNow();
|
|
|
|
return "$a[0] $a[1] => $msg";
|
|
return "NYI"
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
CUL_SetState($$$$)
|
|
{
|
|
my ($hash, $tim, $vt, $val) = @_;
|
|
return "NYI";
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
CUL_DoInit($)
|
|
{
|
|
my $hash = shift;
|
|
my $name = $hash->{NAME};
|
|
|
|
# Clear the pipe
|
|
$hash->{RA_Timeout} = 0.1;
|
|
for(;;) {
|
|
last if(CUL_ReadAnswer($hash, "Clear") =~ m/^Timeout/);
|
|
}
|
|
delete($hash->{RA_Timeout});
|
|
|
|
$hash->{PortObj}->write("V\n");
|
|
my $ver = CUL_ReadAnswer($hash, "Version");
|
|
if($ver !~ m/^V/) {
|
|
$attr{$name}{dummy} = 1;
|
|
$hash->{PortObj}->close();
|
|
my $msg = "Not an CUL device, receives for V: $ver";
|
|
Log 1, $msg;
|
|
return $msg;
|
|
}
|
|
$hash->{PortObj}->write("XFE\n"); # Enable message reporting
|
|
|
|
# Reset the counter
|
|
delete($hash->{XMIT_TIME});
|
|
delete($hash->{NR_CMD_LAST_H});
|
|
}
|
|
|
|
#####################################
|
|
# This is a direct read for commands like get
|
|
sub
|
|
CUL_ReadAnswer($$)
|
|
{
|
|
my ($hash,$arg) = @_;
|
|
|
|
return undef if(!$hash || !defined($hash->{FD}));
|
|
my ($mculdata, $rin) = ("", '');
|
|
my $nfound;
|
|
for(;;) {
|
|
if($^O eq 'MSWin32') {
|
|
$nfound=CUL_Ready($hash, undef);
|
|
} else {
|
|
vec($rin, $hash->{FD}, 1) = 1;
|
|
my $to = 3; # 3 seconds timeout
|
|
$to = $hash->{RA_Timeout} if($hash->{RA_Timeout}); # ...or less
|
|
$nfound = select($rin, undef, undef, $to);
|
|
if($nfound < 0) {
|
|
next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
|
|
die("Select error $nfound / $!\n");
|
|
}
|
|
}
|
|
return "Timeout reading answer for get $arg" if($nfound == 0);
|
|
my $buf = $hash->{PortObj}->input();
|
|
|
|
Log 5, "CUL/RAW: $buf";
|
|
$mculdata .= $buf;
|
|
return $mculdata if($mculdata =~ m/\r\n/);
|
|
}
|
|
}
|
|
|
|
#####################################
|
|
# Check if the 1% limit is reached and trigger notifies
|
|
sub
|
|
CUL_XmitLimitCheck($$)
|
|
{
|
|
my ($hash,$fn) = @_;
|
|
my $now = time();
|
|
|
|
if(!$hash->{XMIT_TIME}) {
|
|
$hash->{XMIT_TIME}[0] = $now;
|
|
$hash->{NR_CMD_LAST_H} = 1;
|
|
return;
|
|
}
|
|
|
|
my $nowM1h = $now-3600;
|
|
my @b = grep { $_ > $nowM1h } @{$hash->{XMIT_TIME}};
|
|
|
|
if(@b > 163) { # Maximum nr of transmissions per hour (unconfirmed).
|
|
|
|
my $me = $hash->{NAME};
|
|
Log GetLogLevel($me,2), "CUL TRANSMIT LIMIT EXCEEDED";
|
|
DoTrigger($me, "TRANSMIT LIMIT EXCEEDED");
|
|
|
|
} else {
|
|
|
|
push(@b, $now);
|
|
|
|
}
|
|
$hash->{XMIT_TIME} = \@b;
|
|
$hash->{NR_CMD_LAST_H} = int(@b);
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
CUL_Write($$$)
|
|
{
|
|
my ($hash,$fn,$msg) = @_;
|
|
|
|
if(!$hash || !defined($hash->{PortObj})) {
|
|
Log 5, "CUL device $hash->{NAME} is not active, cannot send";
|
|
return;
|
|
}
|
|
|
|
###################
|
|
# Rewrite message from FHZ -> CUL
|
|
if(length($fn) == 1) { # CUL Native
|
|
} elsif($fn eq "04" && substr($msg,0,6) eq "010101") { # FS20
|
|
$fn = "F";
|
|
$msg = substr($msg,6);
|
|
} else {
|
|
Log 1, "CUL cannot translate $fn $msg";
|
|
return;
|
|
}
|
|
|
|
|
|
###############
|
|
# insert value into the msghist. At the moment this only makes sense for FS20
|
|
# devices. As the transmitted value differs from the received one, we have to
|
|
# recompute.
|
|
if($fn eq "F" || $fn eq "T") {
|
|
$msghist{$msgcount}{TIME} = gettimeofday();
|
|
$msghist{$msgcount}{NAME} = $hash->{NAME};
|
|
$msghist{$msgcount}{MSG} = "$fn$msg";
|
|
$msgcount++;
|
|
}
|
|
|
|
Log 5, "CUL sending $fn$msg";
|
|
my $bstring = "$fn$msg\n";
|
|
|
|
if($fn eq "F") {
|
|
if(!$hash->{QUEUECNT}) {
|
|
|
|
CUL_XmitLimitCheck($hash, $bstring);
|
|
$hash->{PortObj}->write($bstring);
|
|
|
|
##############
|
|
# Write the next buffer not earlier than 0.227 seconds (= 65.6ms + 10ms +
|
|
# 65.6ms + 10ms + 65.6ms + 10ms)
|
|
InternalTimer(gettimeofday()+0.25, "CUL_HandleWriteQueue", $hash, 1);
|
|
|
|
} elsif($hash->{QUEUECNT} == 1) {
|
|
$hash->{QUEUE} = [ $bstring ];
|
|
} else {
|
|
push(@{$hash->{QUEUE}}, $bstring);
|
|
}
|
|
$hash->{QUEUECNT}++;
|
|
|
|
} else {
|
|
|
|
$hash->{PortObj}->write($bstring);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
CUL_HandleWriteQueue($)
|
|
{
|
|
my $hash = shift;
|
|
my $cnt = --$hash->{QUEUECNT};
|
|
if($cnt > 0) {
|
|
my $bstring = shift(@{$hash->{QUEUE}});
|
|
CUL_XmitLimitCheck($hash,$bstring);
|
|
$hash->{PortObj}->write($bstring);
|
|
InternalTimer(gettimeofday()+0.25, "CUL_HandleWriteQueue", $hash, 1);
|
|
}
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
CUL_Read($)
|
|
{
|
|
my ($hash) = @_;
|
|
|
|
my $buf = $hash->{PortObj}->input();
|
|
my $iohash = $modules{$hash->{TYPE}}; # Our (CUL) module pointer
|
|
my $name = $hash->{NAME};
|
|
|
|
###########
|
|
# Lets' try again: Some drivers return len(0) on the first read...
|
|
if(defined($buf) && length($buf) == 0) {
|
|
$buf = $hash->{PortObj}->input();
|
|
}
|
|
|
|
if(!defined($buf) || length($buf) == 0) {
|
|
|
|
my $devname = $hash->{DeviceName};
|
|
Log 1, "USB device $devname disconnected, waiting to reappear";
|
|
$hash->{PortObj}->close();
|
|
for(;;) {
|
|
sleep(5);
|
|
if ($^O eq 'MSWin32') {
|
|
$hash->{PortObj} = new Win32::SerialPort($devname);
|
|
}else{
|
|
$hash->{PortObj} = new Device::SerialPort($devname);
|
|
}
|
|
|
|
if($hash->{PortObj}) {
|
|
Log 1, "USB device $devname reappeared";
|
|
$hash->{FD} = $hash->{PortObj}->FILENO if !($^O eq 'MSWin32');
|
|
CUL_DoInit($hash);
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
|
|
my $culdata = $hash->{PARTIAL};
|
|
Log 5, "CUL/RAW: $culdata/$buf";
|
|
$culdata .= $buf;
|
|
|
|
while($culdata =~ m/\n/) {
|
|
|
|
my $dmsg;
|
|
($dmsg,$culdata) = split("\n", $culdata);
|
|
$dmsg =~ s/\r//;
|
|
|
|
###############
|
|
# check for duplicate msg from different CUL's
|
|
my $now = gettimeofday();
|
|
my $skip;
|
|
my $meetoo = ($attr{$name}{repeater} ? 1 : 0);
|
|
|
|
my $to = 0.3;
|
|
if(defined($attr{$name}) && defined($attr{$name}{filtertimeout})) {
|
|
$to = $attr{$name}{filtertimeout};
|
|
}
|
|
foreach my $oidx (keys %msghist) {
|
|
if($now-$msghist{$oidx}{TIME} > $to) {
|
|
delete($msghist{$oidx});
|
|
next;
|
|
}
|
|
if($msghist{$oidx}{MSG} eq $dmsg &&
|
|
($meetoo || $msghist{$oidx}{NAME} ne $name)) {
|
|
Log 5, "Skipping $msghist{$oidx}{MSG}";
|
|
$skip = 1;
|
|
}
|
|
}
|
|
goto NEXTMSG if($skip);
|
|
$msghist{$msgcount}{TIME} = $now;
|
|
$msghist{$msgcount}{NAME} = $name;
|
|
$msghist{$msgcount}{MSG} = $dmsg;
|
|
$msgcount++;
|
|
|
|
Log 1, "CUL: $dmsg";
|
|
#Translate Message from CUL to FHZ
|
|
my $fn = substr($dmsg,0,1);
|
|
if($fn eq "F") { # FS20
|
|
$dmsg = sprintf("81%02x04xx0101a001%s00%s",
|
|
length($dmsg)/2+5,
|
|
substr($dmsg,1,6), substr($dmsg,7));
|
|
$dmsg = lc($dmsg);
|
|
|
|
} elsif($fn eq "T") { # FHT
|
|
|
|
$dmsg =~ s/([1-4]\d)79(..)$/${1}69$2/; # should be done in the FHT
|
|
|
|
$dmsg = sprintf("81%02x04xx0909a001%s00%s",
|
|
length($dmsg)/2+5,
|
|
substr($dmsg,1,6), substr($dmsg,7));
|
|
$dmsg = lc($dmsg);
|
|
|
|
} else {
|
|
Log 5, "CUL: unknown message $dmsg";
|
|
goto NEXTMSG;
|
|
}
|
|
|
|
|
|
my @found;
|
|
my $last_module;
|
|
foreach my $m (sort { $modules{$a}{ORDER} cmp $modules{$b}{ORDER} }
|
|
grep {defined($modules{$_}{ORDER});}keys %modules) {
|
|
next if($iohash->{Clients} !~ m/:$m:/);
|
|
|
|
# Module is not loaded or the message is not for this module
|
|
next if(!$modules{$m}{Match} || $dmsg !~ m/$modules{$m}{Match}/i);
|
|
|
|
no strict "refs";
|
|
@found = &{$modules{$m}{ParseFn}}($hash,$dmsg);
|
|
use strict "refs";
|
|
$last_module = $m;
|
|
last if(int(@found));
|
|
}
|
|
if(!int(@found)) {
|
|
Log 1, "Unknown code $dmsg, help me!";
|
|
goto NEXTMSG;
|
|
}
|
|
|
|
goto NEXTMSG if($found[0] eq ""); # Special return: Do not notify
|
|
|
|
if($found[0] =~ m/^(UNDEFINED) ([^ ]*) (.*)$/) {
|
|
my $d = $1;
|
|
$defs{$d}{NAME} = $1;
|
|
$defs{$d}{TYPE} = $last_module;
|
|
DoTrigger($d, "$2 $3");
|
|
delete $defs{$d};
|
|
goto NEXTMSG;
|
|
}
|
|
|
|
foreach my $found (@found) {
|
|
DoTrigger($found, undef);
|
|
}
|
|
NEXTMSG:
|
|
}
|
|
$hash->{PARTIAL} = $culdata;
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
CUL_Ready($$) # Windows - only
|
|
{
|
|
my ($hash, $dev) = @_;
|
|
my $po=$hash->{PortObj};
|
|
return undef if !$po;
|
|
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
|
|
return ($InBytes>0);
|
|
}
|
|
|
|
1;
|