mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-04-16 10:46:03 +00:00
HMLAN ACK handlich and delay adaption
git-svn-id: https://svn.fhem.de/fhem/trunk@2110 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
martinp876
parent
4f436164f8
commit
cb335972e6
@ -199,8 +199,17 @@ sub
|
|||||||
HMLAN_Write($$$)
|
HMLAN_Write($$$)
|
||||||
{
|
{
|
||||||
my ($hash,$fn,$msg) = @_;
|
my ($hash,$fn,$msg) = @_;
|
||||||
my $dst = substr($msg, 16, 6);
|
my ($mtype,$src,$dst) = (substr($msg, 8, 2),
|
||||||
|
substr($msg, 10, 6),
|
||||||
|
substr($msg, 16, 6));
|
||||||
|
|
||||||
|
if ($mtype eq "02" && $src eq $hash->{owner}){
|
||||||
|
# Acks are generally send by HMLAN
|
||||||
|
# So far there is no need to send own
|
||||||
|
Log 5, "HMLAN: Skip ACK";
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
# my $IDHM = '+'.$dst.',01,00,F1EF'; #used by HMconfig - meanning??
|
# my $IDHM = '+'.$dst.',01,00,F1EF'; #used by HMconfig - meanning??
|
||||||
my $IDadd = '+'.$dst.',00,00,'; # guess: add ID?
|
my $IDadd = '+'.$dst.',00,00,'; # guess: add ID?
|
||||||
my $IDsub = '-'.$dst; # guess: ID remove?
|
my $IDsub = '-'.$dst; # guess: ID remove?
|
||||||
@ -276,25 +285,29 @@ HMLAN_Parse($$)
|
|||||||
|
|
||||||
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]
|
Log $ll5, 'HMLAN_Parse: '.$name.' S:'.$mFld[0]
|
||||||
# .(if($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:'.$mFld[5];
|
||||||
# ' m:'.substr($mFld[5],0,2).
|
# .' m:'.substr($mFld[5],0,2)
|
||||||
# ' '.substr($mFld[5],2,4).
|
# .' '.substr($mFld[5],2,4)
|
||||||
# ' '.substr($mFld[5],6,6).
|
# .' '.substr($mFld[5],6,6)
|
||||||
# ' '.substr($mFld[5],12,6).
|
# .' '.substr($mFld[5],12,6)
|
||||||
# ' '.substr($mFld[5],18);
|
# .' '.substr($mFld[5],18);
|
||||||
|
|
||||||
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]));
|
||||||
|
|
||||||
my $src = substr($mFld[5],6,6);
|
my $src = substr($mFld[5],6,6);
|
||||||
my $dst = substr($mFld[5],12,6);
|
my $dst = substr($mFld[5],12,6);
|
||||||
my $flg = hex(substr($mFld[5],2,2));
|
my $flg = hex(substr($mFld[5],2,2));
|
||||||
# handle status. 1-ack,8=nack,21=?,02=? 81=open
|
|
||||||
|
# handle status. 01=ack:seems to announce the new message counter
|
||||||
HMLAN_SimpleWrite($hash, '+'.$src) if (($letter eq 'R')); #ok
|
# 02=our send message returned it was likely not sent
|
||||||
|
# 08=nack,
|
||||||
|
# 21=?,
|
||||||
|
# 81=open
|
||||||
|
HMLAN_SimpleWrite($hash, '+'.$src) if (($letter eq 'R'));
|
||||||
|
|
||||||
if (!($flg & 0x25)){#rule out other messages
|
if (!($flg & 0x25)){#rule out other messages
|
||||||
HMLAN_SimpleWrite($hash, '-'.$src);
|
HMLAN_SimpleWrite($hash, '-'.$src);
|
||||||
@ -352,33 +365,36 @@ HMLAN_SimpleWrite(@)
|
|||||||
|
|
||||||
# select(undef, undef, undef, 0.01); # todo check necessity
|
# select(undef, undef, undef, 0.01); # todo check necessity
|
||||||
#---------- confort trace--------------
|
#---------- confort trace--------------
|
||||||
# Log GetLogLevel($name,5), 'HMLAN_Send: S:'.
|
# Log GetLogLevel($name,5), 'HMLAN_Send: S:'.
|
||||||
# substr($msg,0,9).
|
# substr($msg,0,9).
|
||||||
# ' stat: '.substr($msg,10,2).
|
#
|
||||||
# ' t:' .substr($msg,13,8).
|
# ' stat: '.substr($msg,10,2).
|
||||||
# ' d:' .substr($msg,22,2).
|
# ' t:' .substr($msg,13,8).
|
||||||
# ' r:' .substr($msg,25,8).
|
# ' d:' .substr($msg,22,2).
|
||||||
|
# ' r:' .substr($msg,25,8).
|
||||||
# ' m:' .substr($msg,34)
|
# ' m:' .substr($msg,34)
|
||||||
|
#
|
||||||
# ' m:' .substr($msg,34,2).
|
# ' m:' .substr($msg,34,2).
|
||||||
# ' ' .substr($msg,36,4).
|
# ' ' .substr($msg,36,4).
|
||||||
# ' ' .substr($msg,40,6).
|
# ' ' .substr($msg,40,6).
|
||||||
# ' ' .substr($msg,46,6).
|
# ' ' .substr($msg,46,6).
|
||||||
# ' ' .substr($msg,52)
|
# ' ' .substr($msg,52)
|
||||||
|
#
|
||||||
# if (length($msg )>19);
|
# if (length($msg )>19);
|
||||||
# Log GetLogLevel($name,5), 'HMLAN_Send: '.$msg if (length($msg) <=19);
|
# Log GetLogLevel($name,5), 'HMLAN_Send: '.$msg if (length($msg) <=19);
|
||||||
#----------- normal trace,better speed-----------
|
#----------- normal trace,better speed-----------
|
||||||
Log GetLogLevel($name,5), 'HMLAN_Send: '.$msg; #normal trace
|
Log GetLogLevel($name,5), '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
|
||||||
#my $ct = gettimeofday();
|
for (my$cnt=0;$cnt<10;$cnt++){ # no more then 10 itterations!!! fault save
|
||||||
#select(undef, undef, undef, 0.01) if($hash->{helper}{nextSend} >$ct);
|
last if ($hash->{helper}{nextSend} <gettimeofday());
|
||||||
#$hash->{helper}{nextSend} = $ct + 0.01; # experimental value.
|
select(undef, undef, undef, 0.01);
|
||||||
select(undef, undef, undef, 0.01);
|
}
|
||||||
|
|
||||||
syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
|
syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
|
||||||
|
$hash->{helper}{nextSend} = gettimeofday() + 0.01; # experimental value.
|
||||||
}
|
}
|
||||||
|
|
||||||
########################
|
########################
|
||||||
|
|||||||
@ -41,6 +41,9 @@ sub CUL_HM_decodeTime16($);
|
|||||||
sub CUL_HM_pushConfig($$$$$$$$);
|
sub CUL_HM_pushConfig($$$$$$$$);
|
||||||
sub CUL_HM_maticFn($$$$$);
|
sub CUL_HM_maticFn($$$$$);
|
||||||
sub CUL_HM_secSince2000();
|
sub CUL_HM_secSince2000();
|
||||||
|
# ----------------modul globals-----------------------
|
||||||
|
my $respRemoved; # used to control trigger of stach processing
|
||||||
|
# need to take care that ACK is first
|
||||||
|
|
||||||
my %culHmDevProps=(
|
my %culHmDevProps=(
|
||||||
"01" => { st => "AlarmControl", cl => "controller" }, # by peterp
|
"01" => { st => "AlarmControl", cl => "controller" }, # by peterp
|
||||||
@ -330,7 +333,8 @@ CUL_HM_Parse($$)
|
|||||||
|
|
||||||
return "" if($p =~ m/NACK$/);#discard TCP errors from HMlan. Resend will cover it
|
return "" if($p =~ m/NACK$/);#discard TCP errors from HMlan. Resend will cover it
|
||||||
return "" if($src eq $id);#discard mirrored messages
|
return "" if($src eq $id);#discard mirrored messages
|
||||||
|
|
||||||
|
$respRemoved = 0; #set to 'no response in this message' at start
|
||||||
if(!$shash) { # Unknown source
|
if(!$shash) { # Unknown source
|
||||||
# Generate an UNKNOWN event for pairing requests, ignore everything else
|
# Generate an UNKNOWN event for pairing requests, ignore everything else
|
||||||
if($msgType eq "00") {
|
if($msgType eq "00") {
|
||||||
@ -746,7 +750,8 @@ CUL_HM_Parse($$)
|
|||||||
|
|
||||||
if($id eq $dst) { # Send Ack
|
if($id eq $dst) { # Send Ack
|
||||||
CUL_HM_SendCmd($shash, $msgcnt."8002".$id.$src."0101".
|
CUL_HM_SendCmd($shash, $msgcnt."8002".$id.$src."0101".
|
||||||
($state =~ m/on/?"C8":"00")."00", 1, 0);#Actor simulation
|
($state =~ m/on/?"C8":"00")."00", 1, 0);#Actor simulation
|
||||||
|
|
||||||
$sendAck = "";
|
$sendAck = "";
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -976,7 +981,7 @@ CUL_HM_Parse($$)
|
|||||||
} elsif($lst eq "00" && $flg eq "30") { push @event, "contact:open";
|
} elsif($lst eq "00" && $flg eq "30") { push @event, "contact:open";
|
||||||
}
|
}
|
||||||
CUL_HM_SendCmd($shash, $msgcnt."8002".$id.$src."0101".$lst."00",1,0)
|
CUL_HM_SendCmd($shash, $msgcnt."8002".$id.$src."0101".$lst."00",1,0)
|
||||||
if($id eq $dst);# Send AckStatus
|
if($id eq $dst);# Send AckStatus
|
||||||
$sendAck = "";
|
$sendAck = "";
|
||||||
}
|
}
|
||||||
elsif ($p =~ m/^0287(..)89(..)8B(..)/) {
|
elsif ($p =~ m/^0287(..)89(..)8B(..)/) {
|
||||||
@ -1055,11 +1060,12 @@ CUL_HM_Parse($$)
|
|||||||
# parser did not supress
|
# parser did not supress
|
||||||
CUL_HM_SendCmd($shash, $msgcnt."8002".$id.$src."00",1,0) # Send Ack
|
CUL_HM_SendCmd($shash, $msgcnt."8002".$id.$src."00",1,0) # Send Ack
|
||||||
if( ($id eq $dst) #are we adressee
|
if( ($id eq $dst) #are we adressee
|
||||||
# && ($msgType ne "02") #no ack for ack
|
|
||||||
&& (hex($msgFlag)&0x20) #response required Flag
|
&& (hex($msgFlag)&0x20) #response required Flag
|
||||||
&& @event #only ack of we identified it
|
&& @event #only ack of we identified it
|
||||||
&& ($sendAck eq "yes") #sender requested ACK
|
&& ($sendAck eq "yes") #sender requested ACK
|
||||||
);
|
);
|
||||||
|
|
||||||
|
CUL_HM_ProcessCmdStack($shash) if ($respRemoved); # cont stack if a response is complete
|
||||||
#------------ process events ------------------
|
#------------ process events ------------------
|
||||||
push @event, "noReceiver:src:$src ($cmd) $p" if(!@event);
|
push @event, "noReceiver:src:$src ($cmd) $p" if(!@event);
|
||||||
|
|
||||||
@ -2437,8 +2443,7 @@ CUL_HM_getConfig($$$$$){
|
|||||||
#$listNo,$chnValid $peerReq
|
#$listNo,$chnValid $peerReq
|
||||||
if ($chnValid){# yes, we will go for a list
|
if ($chnValid){# yes, we will go for a list
|
||||||
if ($peerReq){# need to get the peers first
|
if ($peerReq){# need to get the peers first
|
||||||
# CUL_HM_PushCmdStack($hash,sprintf("++%s01%s%s%s03",$flag,$id,$dst,$chn));
|
$chnhash->{helper}{getCfgList} = "all"; # peers first
|
||||||
$chnhash->{helper}{getCfgList} = "all";# peers first
|
|
||||||
$chnhash->{helper}{getCfgListNo} = $listNo;
|
$chnhash->{helper}{getCfgListNo} = $listNo;
|
||||||
}
|
}
|
||||||
else{
|
else{
|
||||||
@ -2492,7 +2497,8 @@ CUL_HM_responseSetup($$$)
|
|||||||
$hash->{helper}{respWait}{forChn} = substr($p,0,2);#channel info we await
|
$hash->{helper}{respWait}{forChn} = substr($p,0,2);#channel info we await
|
||||||
|
|
||||||
# define timeout - holdup cmdStack until response complete or timeout
|
# define timeout - holdup cmdStack until response complete or timeout
|
||||||
InternalTimer(gettimeofday()+$rTo, "CUL_HM_respPendTout", "respPend:$dst", 0);
|
InternalTimer(gettimeofday()+$rTo, "CUL_HM_respPendTout", "respPend:$dst", 0);
|
||||||
|
|
||||||
#--- remove readings in channel
|
#--- remove readings in channel
|
||||||
my $chnhash = $modules{CUL_HM}{defptr}{"$dst$chn"};
|
my $chnhash = $modules{CUL_HM}{defptr}{"$dst$chn"};
|
||||||
$chnhash = $hash if (!$chnhash);
|
$chnhash = $hash if (!$chnhash);
|
||||||
@ -2571,7 +2577,7 @@ CUL_HM_eventP($$)
|
|||||||
$nAttr->{protCmdDel} += scalar @{$hash->{cmdStack}} if ($hash->{cmdStack});
|
$nAttr->{protCmdDel} += scalar @{$hash->{cmdStack}} if ($hash->{cmdStack});
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
###################################
|
###################################
|
||||||
sub
|
sub
|
||||||
CUL_HM_respPendRm($)
|
CUL_HM_respPendRm($)
|
||||||
{ # delete all response related entries in messageing entity
|
{ # delete all response related entries in messageing entity
|
||||||
@ -2579,8 +2585,7 @@ CUL_HM_respPendRm($)
|
|||||||
delete ($hash->{helper}{respWait});
|
delete ($hash->{helper}{respWait});
|
||||||
RemoveInternalTimer($hash); # remove resend-timer
|
RemoveInternalTimer($hash); # remove resend-timer
|
||||||
RemoveInternalTimer("respPend:$hash->{DEF}");# remove responsePending timer
|
RemoveInternalTimer("respPend:$hash->{DEF}");# remove responsePending timer
|
||||||
|
$respRemoved = 1;
|
||||||
CUL_HM_ProcessCmdStack($hash); # continue processing commands
|
|
||||||
}
|
}
|
||||||
###################################
|
###################################
|
||||||
sub
|
sub
|
||||||
@ -2592,7 +2597,8 @@ CUL_HM_respPendTout($)
|
|||||||
if ($hash){
|
if ($hash){
|
||||||
CUL_HM_eventP($hash,"Tout") if ($hash->{helper}{respWait}{cmd});
|
CUL_HM_eventP($hash,"Tout") if ($hash->{helper}{respWait}{cmd});
|
||||||
CUL_HM_eventP($hash,"ToutResp") if ($hash->{helper}{respWait}{Pending});
|
CUL_HM_eventP($hash,"ToutResp") if ($hash->{helper}{respWait}{Pending});
|
||||||
CUL_HM_respPendRm($hash);
|
CUL_HM_respPendRm($hash);
|
||||||
|
CUL_HM_ProcessCmdStack($hash); # continue processing commands
|
||||||
DoTrigger($hash->{NAME}, "RESPONSE TIMEOUT");
|
DoTrigger($hash->{NAME}, "RESPONSE TIMEOUT");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -3055,7 +3061,6 @@ CUL_HM_parseCommon(@){
|
|||||||
$flag,$id,$src,$chn,$peer,$listNo));# List3 or 4
|
$flag,$id,$src,$chn,$peer,$listNo));# List3 or 4
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
CUL_HM_ProcessCmdStack($shash);
|
|
||||||
}
|
}
|
||||||
delete $chnhash->{helper}{getCfgList};
|
delete $chnhash->{helper}{getCfgList};
|
||||||
delete $chnhash->{helper}{getCfgListNo};
|
delete $chnhash->{helper}{getCfgListNo};
|
||||||
@ -3105,6 +3110,7 @@ CUL_HM_parseCommon(@){
|
|||||||
CUL_HM_getRegFromStore($name,11,0,"00000000"),
|
CUL_HM_getRegFromStore($name,11,0,"00000000"),
|
||||||
CUL_HM_getRegFromStore($name,12,0,"00000000")),"");
|
CUL_HM_getRegFromStore($name,12,0,"00000000")),"");
|
||||||
}
|
}
|
||||||
|
|
||||||
CUL_HM_respPendRm($shash);
|
CUL_HM_respPendRm($shash);
|
||||||
delete $chnhash->{helper}{shadowReg}{$regLN};#remove shadowhash
|
delete $chnhash->{helper}{shadowReg}{$regLN};#remove shadowhash
|
||||||
}
|
}
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user