2
0
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 2012-11-11 19:09:21 +00:00
parent 4f436164f8
commit cb335972e6
2 changed files with 65 additions and 43 deletions

View File

@ -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.
}
########################

View File

@ -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
}