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:
parent
4f436164f8
commit
cb335972e6
@ -199,7 +199,16 @@ sub
|
||||
HMLAN_Write($$$)
|
||||
{
|
||||
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 $IDadd = '+'.$dst.',00,00,'; # guess: add ID?
|
||||
@ -276,25 +285,29 @@ HMLAN_Parse($$)
|
||||
|
||||
if ($letter =~ m/^[ER]/){#@mFld=($src, $status, $msec, $d2, $rssi, $msg)
|
||||
Log $ll5, 'HMLAN_Parse: '.$name.' S:'.$mFld[0]
|
||||
# .(if($mFld[0] =~ m/^E/)?' ':'')
|
||||
.(($mFld[0] =~ m/^E/)?' ':'')
|
||||
.' stat:'.$mFld[1]
|
||||
.' t:'.$mFld[2].' d:'.$mFld[3]
|
||||
.' r:'.$mFld[4].
|
||||
'm:'.$mFld[5];
|
||||
# ' m:'.substr($mFld[5],0,2).
|
||||
# ' '.substr($mFld[5],2,4).
|
||||
# ' '.substr($mFld[5],6,6).
|
||||
# ' '.substr($mFld[5],12,6).
|
||||
# ' '.substr($mFld[5],18);
|
||||
.' r:'.$mFld[4]
|
||||
.'m:'.$mFld[5];
|
||||
# .' m:'.substr($mFld[5],0,2)
|
||||
# .' '.substr($mFld[5],2,4)
|
||||
# .' '.substr($mFld[5],6,6)
|
||||
# .' '.substr($mFld[5],12,6)
|
||||
# .' '.substr($mFld[5],18);
|
||||
|
||||
my $dmsg = sprintf("A%02X%s", length($mFld[5])/2, uc($mFld[5]));
|
||||
|
||||
my $src = substr($mFld[5],6,6);
|
||||
my $dst = substr($mFld[5],12,6);
|
||||
my $flg = hex(substr($mFld[5],2,2));
|
||||
# handle status. 1-ack,8=nack,21=?,02=? 81=open
|
||||
|
||||
HMLAN_SimpleWrite($hash, '+'.$src) if (($letter eq 'R')); #ok
|
||||
# handle status. 01=ack:seems to announce the new message counter
|
||||
# 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
|
||||
HMLAN_SimpleWrite($hash, '-'.$src);
|
||||
@ -352,33 +365,36 @@ HMLAN_SimpleWrite(@)
|
||||
|
||||
# select(undef, undef, undef, 0.01); # todo check necessity
|
||||
#---------- confort trace--------------
|
||||
# Log GetLogLevel($name,5), 'HMLAN_Send: S:'.
|
||||
# substr($msg,0,9).
|
||||
# ' stat: '.substr($msg,10,2).
|
||||
# ' t:' .substr($msg,13,8).
|
||||
# ' d:' .substr($msg,22,2).
|
||||
# ' r:' .substr($msg,25,8).
|
||||
# Log GetLogLevel($name,5), 'HMLAN_Send: S:'.
|
||||
# substr($msg,0,9).
|
||||
#
|
||||
# ' stat: '.substr($msg,10,2).
|
||||
# ' t:' .substr($msg,13,8).
|
||||
# ' d:' .substr($msg,22,2).
|
||||
# ' r:' .substr($msg,25,8).
|
||||
# ' m:' .substr($msg,34)
|
||||
|
||||
# ' m:' .substr($msg,34,2).
|
||||
# ' ' .substr($msg,36,4).
|
||||
# ' ' .substr($msg,40,6).
|
||||
# ' ' .substr($msg,46,6).
|
||||
# ' ' .substr($msg,52)
|
||||
#
|
||||
# ' m:' .substr($msg,34,2).
|
||||
# ' ' .substr($msg,36,4).
|
||||
# ' ' .substr($msg,40,6).
|
||||
# ' ' .substr($msg,46,6).
|
||||
# ' ' .substr($msg,52)
|
||||
#
|
||||
# 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-----------
|
||||
Log GetLogLevel($name,5), 'HMLAN_Send: '.$msg; #normal trace
|
||||
|
||||
$msg .= "\r\n" unless($nonl);
|
||||
|
||||
# Currently it does not seem to be necessary to wait Thus this code is inhibit for now
|
||||
#my $ct = gettimeofday();
|
||||
#select(undef, undef, undef, 0.01) if($hash->{helper}{nextSend} >$ct);
|
||||
#$hash->{helper}{nextSend} = $ct + 0.01; # experimental value.
|
||||
select(undef, undef, undef, 0.01);
|
||||
for (my$cnt=0;$cnt<10;$cnt++){ # no more then 10 itterations!!! fault save
|
||||
last if ($hash->{helper}{nextSend} <gettimeofday());
|
||||
select(undef, undef, undef, 0.01);
|
||||
}
|
||||
|
||||
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_maticFn($$$$$);
|
||||
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=(
|
||||
"01" => { st => "AlarmControl", cl => "controller" }, # by peterp
|
||||
@ -331,6 +334,7 @@ CUL_HM_Parse($$)
|
||||
return "" if($p =~ m/NACK$/);#discard TCP errors from HMlan. Resend will cover it
|
||||
return "" if($src eq $id);#discard mirrored messages
|
||||
|
||||
$respRemoved = 0; #set to 'no response in this message' at start
|
||||
if(!$shash) { # Unknown source
|
||||
# Generate an UNKNOWN event for pairing requests, ignore everything else
|
||||
if($msgType eq "00") {
|
||||
@ -747,6 +751,7 @@ CUL_HM_Parse($$)
|
||||
if($id eq $dst) { # Send Ack
|
||||
CUL_HM_SendCmd($shash, $msgcnt."8002".$id.$src."0101".
|
||||
($state =~ m/on/?"C8":"00")."00", 1, 0);#Actor simulation
|
||||
|
||||
$sendAck = "";
|
||||
}
|
||||
|
||||
@ -1055,11 +1060,12 @@ CUL_HM_Parse($$)
|
||||
# parser did not supress
|
||||
CUL_HM_SendCmd($shash, $msgcnt."8002".$id.$src."00",1,0) # Send Ack
|
||||
if( ($id eq $dst) #are we adressee
|
||||
# && ($msgType ne "02") #no ack for ack
|
||||
&& (hex($msgFlag)&0x20) #response required Flag
|
||||
&& @event #only ack of we identified it
|
||||
&& ($sendAck eq "yes") #sender requested ACK
|
||||
);
|
||||
|
||||
CUL_HM_ProcessCmdStack($shash) if ($respRemoved); # cont stack if a response is complete
|
||||
#------------ process events ------------------
|
||||
push @event, "noReceiver:src:$src ($cmd) $p" if(!@event);
|
||||
|
||||
@ -2437,8 +2443,7 @@ CUL_HM_getConfig($$$$$){
|
||||
#$listNo,$chnValid $peerReq
|
||||
if ($chnValid){# yes, we will go for a list
|
||||
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;
|
||||
}
|
||||
else{
|
||||
@ -2493,6 +2498,7 @@ CUL_HM_responseSetup($$$)
|
||||
|
||||
# define timeout - holdup cmdStack until response complete or timeout
|
||||
InternalTimer(gettimeofday()+$rTo, "CUL_HM_respPendTout", "respPend:$dst", 0);
|
||||
|
||||
#--- remove readings in channel
|
||||
my $chnhash = $modules{CUL_HM}{defptr}{"$dst$chn"};
|
||||
$chnhash = $hash if (!$chnhash);
|
||||
@ -2579,8 +2585,7 @@ CUL_HM_respPendRm($)
|
||||
delete ($hash->{helper}{respWait});
|
||||
RemoveInternalTimer($hash); # remove resend-timer
|
||||
RemoveInternalTimer("respPend:$hash->{DEF}");# remove responsePending timer
|
||||
|
||||
CUL_HM_ProcessCmdStack($hash); # continue processing commands
|
||||
$respRemoved = 1;
|
||||
}
|
||||
###################################
|
||||
sub
|
||||
@ -2593,6 +2598,7 @@ CUL_HM_respPendTout($)
|
||||
CUL_HM_eventP($hash,"Tout") if ($hash->{helper}{respWait}{cmd});
|
||||
CUL_HM_eventP($hash,"ToutResp") if ($hash->{helper}{respWait}{Pending});
|
||||
CUL_HM_respPendRm($hash);
|
||||
CUL_HM_ProcessCmdStack($hash); # continue processing commands
|
||||
DoTrigger($hash->{NAME}, "RESPONSE TIMEOUT");
|
||||
}
|
||||
}
|
||||
@ -3055,7 +3061,6 @@ CUL_HM_parseCommon(@){
|
||||
$flag,$id,$src,$chn,$peer,$listNo));# List3 or 4
|
||||
}
|
||||
}
|
||||
CUL_HM_ProcessCmdStack($shash);
|
||||
}
|
||||
delete $chnhash->{helper}{getCfgList};
|
||||
delete $chnhash->{helper}{getCfgListNo};
|
||||
@ -3105,6 +3110,7 @@ CUL_HM_parseCommon(@){
|
||||
CUL_HM_getRegFromStore($name,11,0,"00000000"),
|
||||
CUL_HM_getRegFromStore($name,12,0,"00000000")),"");
|
||||
}
|
||||
|
||||
CUL_HM_respPendRm($shash);
|
||||
delete $chnhash->{helper}{shadowReg}{$regLN};#remove shadowhash
|
||||
}
|
||||
|
Loading…
x
Reference in New Issue
Block a user