mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-04-12 08:41:41 +00:00
obey HM device latency in HMLAN - other bug fixes
git-svn-id: https://svn.fhem.de/fhem/trunk@2123 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
martinp876
parent
8e07b7a5bb
commit
100b19af1d
@ -15,6 +15,7 @@ sub HMLAN_secSince2000();
|
|||||||
|
|
||||||
sub HMLAN_SimpleWrite(@);
|
sub HMLAN_SimpleWrite(@);
|
||||||
|
|
||||||
|
my $debug = 0; # set 1 for better log readability
|
||||||
my %sets = (
|
my %sets = (
|
||||||
"hmPairForSec" => "HomeMatic",
|
"hmPairForSec" => "HomeMatic",
|
||||||
"hmPairSerial" => "HomeMatic",
|
"hmPairSerial" => "HomeMatic",
|
||||||
@ -72,7 +73,6 @@ HMLAN_Define($$)
|
|||||||
return undef;
|
return undef;
|
||||||
}
|
}
|
||||||
$hash->{DeviceName} = $dev;
|
$hash->{DeviceName} = $dev;
|
||||||
$hash->{helper}{nextSend}=gettimeofday();
|
|
||||||
my $ret = DevIo_OpenDev($hash, 0, "HMLAN_DoInit");
|
my $ret = DevIo_OpenDev($hash, 0, "HMLAN_DoInit");
|
||||||
return $ret;
|
return $ret;
|
||||||
}
|
}
|
||||||
@ -202,40 +202,28 @@ HMLAN_Write($$$)
|
|||||||
my ($mtype,$src,$dst) = (substr($msg, 8, 2),
|
my ($mtype,$src,$dst) = (substr($msg, 8, 2),
|
||||||
substr($msg, 10, 6),
|
substr($msg, 10, 6),
|
||||||
substr($msg, 16, 6));
|
substr($msg, 16, 6));
|
||||||
|
my $ll5 = GetLogLevel($hash->{NAME},5);
|
||||||
|
|
||||||
if ($mtype eq "02" && $src eq $hash->{owner}){
|
if ($mtype eq "02" && $src eq $hash->{owner} && length($msg) == 24){
|
||||||
# Acks are generally send by HMLAN
|
# Acks are generally send by HMLAN autonomously
|
||||||
# So far there is no need to send own
|
# Special
|
||||||
Log 5, "HMLAN: Skip ACK";
|
Log $ll5, "HMLAN: Skip ACK";
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# my $IDHM = '+'.$dst.',01,00,F1EF'; #used by HMconfig - meanning??
|
|
||||||
my $IDadd = '+'.$dst.',00,00,'; # guess: add ID?
|
|
||||||
my $IDsub = '-'.$dst; # guess: ID remove?
|
|
||||||
# my $IDact = '+'.$dst; # guess: ID recover? Different to IDadd?
|
# my $IDact = '+'.$dst; # guess: ID recover? Different to IDadd?
|
||||||
# my $IDack = '+'.$dst.',02,00,'; # guess: ID acknowledge
|
# my $IDack = '+'.$dst.',02,00,'; # guess: ID acknowledge
|
||||||
|
# my $IDHM = '+'.$dst.',01,00,F1EF'; #used by HMconfig - meanning??
|
||||||
|
|
||||||
|
|
||||||
|
my $IDadd = '+'.$dst.',00,00,'; # guess: add ID?
|
||||||
|
my $IDsub = '-'.$dst; # guess: ID remove?
|
||||||
|
|
||||||
HMLAN_SimpleWrite($hash, $IDadd) if (!$lhash{$dst});
|
HMLAN_SimpleWrite($hash, $IDadd) if (!$lhash{$dst});
|
||||||
$lhash{$dst} = 1;
|
$lhash{$dst} = 1;
|
||||||
|
|
||||||
if(hex(substr($msg, 6, 2))&0x01){ # wakeup sequence for TC... hmmm
|
|
||||||
HMLAN_SimpleWrite($hash, $IDadd);
|
|
||||||
HMLAN_SimpleWrite($hash, $IDadd);
|
|
||||||
HMLAN_SimpleWrite($hash, $IDadd);
|
|
||||||
HMLAN_SimpleWrite($hash, $IDsub);
|
|
||||||
HMLAN_SimpleWrite($hash, $IDadd);
|
|
||||||
HMLAN_SimpleWrite($hash, $IDadd);
|
|
||||||
HMLAN_SimpleWrite($hash, $IDadd);
|
|
||||||
HMLAN_SimpleWrite($hash, $IDadd);
|
|
||||||
#HMLAN_SimpleWrite($hash, "+$dst,01,00,F1EF\x0d\x0a");
|
|
||||||
}
|
|
||||||
my $tm = int(gettimeofday()*1000) % 0xffffffff;
|
my $tm = int(gettimeofday()*1000) % 0xffffffff;
|
||||||
$msg = sprintf("S%08X,00,00000000,01,%08X,%s",$tm, $tm, substr($msg, 4));
|
$msg = sprintf("S%08X,00,00000000,01,%08X,%s",$tm, $tm, substr($msg, 4));
|
||||||
HMLAN_SimpleWrite($hash, $msg);
|
HMLAN_SimpleWrite($hash, $msg);
|
||||||
|
|
||||||
# Avoid problems with structure set
|
|
||||||
# TODO: rewrite it to use a queue+internaltimer like the CUL
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#####################################
|
#####################################
|
||||||
@ -248,9 +236,10 @@ HMLAN_Read($)
|
|||||||
my $buf = DevIo_SimpleRead($hash);
|
my $buf = DevIo_SimpleRead($hash);
|
||||||
return "" if(!defined($buf));
|
return "" if(!defined($buf));
|
||||||
my $name = $hash->{NAME};
|
my $name = $hash->{NAME};
|
||||||
|
my $ll5 = GetLogLevel($name,5);
|
||||||
|
|
||||||
my $hmdata = $hash->{PARTIAL};
|
my $hmdata = $hash->{PARTIAL};
|
||||||
# Log 5, "HMLAN/RAW: $hmdata/$buf";
|
Log $ll5, "HMLAN/RAW: $hmdata/$buf" if (!$debug);
|
||||||
$hmdata .= $buf;
|
$hmdata .= $buf;
|
||||||
|
|
||||||
while($hmdata =~ m/\n/) {
|
while($hmdata =~ m/\n/) {
|
||||||
@ -284,17 +273,30 @@ HMLAN_Parse($$)
|
|||||||
my $letter = substr($mFld[0],0,1); # get leading char
|
my $letter = substr($mFld[0],0,1); # get leading char
|
||||||
|
|
||||||
if ($letter =~ m/^[ER]/){#@mFld=($src, $status, $msec, $d2, $rssi, $msg)
|
if ($letter =~ m/^[ER]/){#@mFld=($src, $status, $msec, $d2, $rssi, $msg)
|
||||||
Log $ll5, 'HMLAN_Parse: '.$name.' S:'.$mFld[0]
|
# max speed for devices is 100ms after receive - example:TC
|
||||||
|
# will prepare the delay here
|
||||||
|
my $srcId = (length($mFld[5])>11)?substr($mFld[5],6,6):"lastRec";
|
||||||
|
$hash->{helper}{nextSend}{$srcId} = gettimeofday() + 0.100;
|
||||||
|
if ($debug){
|
||||||
|
Log $ll5, 'HMLAN_Parse: '.$name.' S:'.$mFld[0]
|
||||||
.(($mFld[0] =~ m/^E/)?' ':'')
|
.(($mFld[0] =~ m/^E/)?' ':'')
|
||||||
.' stat:'.$mFld[1]
|
.' stat:'.$mFld[1]
|
||||||
.' t:'.$mFld[2].' d:'.$mFld[3]
|
.' t:'.$mFld[2].' d:'.$mFld[3]
|
||||||
.' r:'.$mFld[4]
|
.' r:'.$mFld[4]
|
||||||
.'m:'.$mFld[5];
|
.' m:'.substr($mFld[5],0,2)
|
||||||
# .' m:'.substr($mFld[5],0,2)
|
.' '.substr($mFld[5],2,4)
|
||||||
# .' '.substr($mFld[5],2,4)
|
.' '.$srcId
|
||||||
# .' '.substr($mFld[5],6,6)
|
.' '.substr($mFld[5],12,6)
|
||||||
# .' '.substr($mFld[5],12,6)
|
.' '.substr($mFld[5],18);
|
||||||
# .' '.substr($mFld[5],18);
|
}
|
||||||
|
else{
|
||||||
|
Log $ll5, 'HMLAN_Parse: '.$name.' S:'.$mFld[0]
|
||||||
|
.(($mFld[0] =~ m/^E/)?' ':'')
|
||||||
|
.' stat:'.$mFld[1]
|
||||||
|
.' t:'.$mFld[2].' d:'.$mFld[3]
|
||||||
|
.' r:'.$mFld[4]
|
||||||
|
.' m:'.$mFld[5];
|
||||||
|
}
|
||||||
|
|
||||||
my $dmsg = sprintf("A%02X%s", length($mFld[5])/2, uc($mFld[5]));
|
my $dmsg = sprintf("A%02X%s", length($mFld[5])/2, uc($mFld[5]));
|
||||||
|
|
||||||
@ -304,7 +306,7 @@ HMLAN_Parse($$)
|
|||||||
|
|
||||||
# handle status. 01=ack:seems to announce the new message counter
|
# handle status. 01=ack:seems to announce the new message counter
|
||||||
# 02=our send message returned it was likely not sent
|
# 02=our send message returned it was likely not sent
|
||||||
# 08=nack,
|
# 08=nack - HMLAN did not receive an ACK,
|
||||||
# 21=?,
|
# 21=?,
|
||||||
# 81=open
|
# 81=open
|
||||||
HMLAN_SimpleWrite($hash, '+'.$src) if (($letter eq 'R'));
|
HMLAN_SimpleWrite($hash, '+'.$src) if (($letter eq 'R'));
|
||||||
@ -360,41 +362,44 @@ sub
|
|||||||
HMLAN_SimpleWrite(@)
|
HMLAN_SimpleWrite(@)
|
||||||
{
|
{
|
||||||
my ($hash, $msg, $nonl) = @_;
|
my ($hash, $msg, $nonl) = @_;
|
||||||
my $name = $hash->{NAME};
|
|
||||||
return if(!$hash || AttrVal($hash->{NAME}, "dummy", undef));
|
|
||||||
|
|
||||||
# select(undef, undef, undef, 0.01); # todo check necessity
|
return if(!$hash || AttrVal($hash->{NAME}, "dummy", undef));
|
||||||
#---------- confort trace--------------
|
my $name = $hash->{NAME};
|
||||||
# Log GetLogLevel($name,5), 'HMLAN_Send: S:'.
|
my $ll5 = GetLogLevel($name,5);
|
||||||
# substr($msg,0,9).
|
|
||||||
#
|
if ($debug){
|
||||||
# ' stat: '.substr($msg,10,2).
|
Log $ll5, 'HMLAN_Send: S:'.
|
||||||
# ' t:' .substr($msg,13,8).
|
substr($msg,0,9).
|
||||||
# ' d:' .substr($msg,22,2).
|
|
||||||
# ' r:' .substr($msg,25,8).
|
' stat: '.substr($msg,10,2).
|
||||||
# ' m:' .substr($msg,34)
|
' t:' .substr($msg,13,8).
|
||||||
#
|
' d:' .substr($msg,22,2).
|
||||||
# ' m:' .substr($msg,34,2).
|
' r:' .substr($msg,25,8).
|
||||||
# ' ' .substr($msg,36,4).
|
' m:' .substr($msg,34,2).
|
||||||
# ' ' .substr($msg,40,6).
|
' ' .substr($msg,36,4).
|
||||||
# ' ' .substr($msg,46,6).
|
' ' .substr($msg,40,6).
|
||||||
# ' ' .substr($msg,52)
|
' ' .substr($msg,46,6).
|
||||||
#
|
' ' .substr($msg,52)
|
||||||
# if (length($msg )>19);
|
if (length($msg )>51);
|
||||||
# Log GetLogLevel($name,5), 'HMLAN_Send: '.$msg if (length($msg) <=19);
|
Log $ll5, 'HMLAN_Send: '.$msg if (length($msg) <=51);
|
||||||
#----------- normal trace,better speed-----------
|
}
|
||||||
Log GetLogLevel($name,5), 'HMLAN_Send: '.$msg; #normal trace
|
else{
|
||||||
|
Log $ll5, 'HMLAN_Send: '.$msg; #normal trace
|
||||||
|
}
|
||||||
|
|
||||||
$msg .= "\r\n" unless($nonl);
|
$msg .= "\r\n" unless($nonl);
|
||||||
|
|
||||||
# Currently it does not seem to be necessary to wait Thus this code is inhibit for now
|
# Currently it does not seem to be necessary to wait Thus this code is inhibit for now
|
||||||
for (my$cnt=0;$cnt<10;$cnt++){ # no more then 10 itterations!!! fault save
|
my $id = (length($msg)>51)?substr($msg,46,6):"";
|
||||||
last if ($hash->{helper}{nextSend} <gettimeofday());
|
if ($id){
|
||||||
select(undef, undef, undef, 0.01);
|
my $DevDelay = $hash->{helper}{nextSend}{$id} - gettimeofday();
|
||||||
|
if ($DevDelay > 0.01){# wait less then 10 ms will not work
|
||||||
|
$DevDelay = ((int($DevDelay*100))%100)/100;# security - wait no more then 1 sec
|
||||||
|
select(undef, undef, undef, $DevDelay);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
|
syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
|
||||||
$hash->{helper}{nextSend} = gettimeofday() + 0.01; # experimental value.
|
|
||||||
}
|
}
|
||||||
|
|
||||||
########################
|
########################
|
||||||
@ -430,16 +435,17 @@ HMLAN_KeepAlive($)
|
|||||||
HMLAN_SimpleWrite($hash, "K");
|
HMLAN_SimpleWrite($hash, "K");
|
||||||
InternalTimer(gettimeofday()+25, "HMLAN_KeepAlive", $hash, 1);
|
InternalTimer(gettimeofday()+25, "HMLAN_KeepAlive", $hash, 1);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub
|
sub
|
||||||
HMLAN_secSince2000()
|
HMLAN_secSince2000()
|
||||||
{
|
{
|
||||||
# Calculate the local time in seconds from 2000.
|
# Calculate the local time in seconds from 2000.
|
||||||
my $t = time();
|
my $t = time();
|
||||||
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($t);
|
my @l = localtime($t);
|
||||||
$t -= 946684800; # seconds between 01.01.2000, 00:00 and THE EPOCH (1970)
|
my @g = gmtime($t);
|
||||||
$t -= 7200; # HM Special
|
$t += 60*(($l[2]-$g[2] + ((($l[5]<<9)|$l[7]) <=> (($g[5]<<9)|$g[7])) * 24 + $l[8]) * 60 + $l[1]-$g[1])
|
||||||
$t += fhemTzOffset($t);
|
# timezone and daylight saving...
|
||||||
|
- 946684800 # seconds between 01.01.2000, 00:00 and THE EPOCH (1970)
|
||||||
|
- 7200; # HM Special
|
||||||
return $t;
|
return $t;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
Loading…
x
Reference in New Issue
Block a user