From cb335972e6565f96efa81ee8272ee038e99fdadd Mon Sep 17 00:00:00 2001 From: martinp876 <> Date: Sun, 11 Nov 2012 19:09:21 +0000 Subject: [PATCH] HMLAN ACK handlich and delay adaption git-svn-id: https://svn.fhem.de/fhem/trunk@2110 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/FHEM/00_HMLAN.pm | 76 +++++++++++++++++++++++++----------------- fhem/FHEM/10_CUL_HM.pm | 32 ++++++++++-------- 2 files changed, 65 insertions(+), 43 deletions(-) diff --git a/fhem/FHEM/00_HMLAN.pm b/fhem/FHEM/00_HMLAN.pm index 08359f11c..b74411c32 100755 --- a/fhem/FHEM/00_HMLAN.pm +++ b/fhem/FHEM/00_HMLAN.pm @@ -199,8 +199,17 @@ 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? my $IDsub = '-'.$dst; # guess: ID remove? @@ -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} {TCPDev}, $msg) if($hash->{TCPDev}); + $hash->{helper}{nextSend} = gettimeofday() + 0.01; # experimental value. } ######################## diff --git a/fhem/FHEM/10_CUL_HM.pm b/fhem/FHEM/10_CUL_HM.pm index 03b6a0137..efe135099 100755 --- a/fhem/FHEM/10_CUL_HM.pm +++ b/fhem/FHEM/10_CUL_HM.pm @@ -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 @@ -330,7 +333,8 @@ 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") { @@ -746,7 +750,8 @@ 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 + ($state =~ m/on/?"C8":"00")."00", 1, 0);#Actor simulation + $sendAck = ""; } @@ -976,7 +981,7 @@ CUL_HM_Parse($$) } elsif($lst eq "00" && $flg eq "30") { push @event, "contact:open"; } 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 = ""; } elsif ($p =~ m/^0287(..)89(..)8B(..)/) { @@ -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{ @@ -2492,7 +2497,8 @@ CUL_HM_responseSetup($$$) $hash->{helper}{respWait}{forChn} = substr($p,0,2);#channel info we await # 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 my $chnhash = $modules{CUL_HM}{defptr}{"$dst$chn"}; $chnhash = $hash if (!$chnhash); @@ -2571,7 +2577,7 @@ CUL_HM_eventP($$) $nAttr->{protCmdDel} += scalar @{$hash->{cmdStack}} if ($hash->{cmdStack}); } } -################################### +################################### sub CUL_HM_respPendRm($) { # delete all response related entries in messageing entity @@ -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 @@ -2592,7 +2597,8 @@ CUL_HM_respPendTout($) if ($hash){ 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_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 }