From ae8482245a67cd38c0695d01386f071961fea2b0 Mon Sep 17 00:00:00 2001 From: martinp876 <> Date: Sun, 8 Sep 2013 14:57:34 +0000 Subject: [PATCH] introduce flow contorl for HMLAN git-svn-id: https://svn.fhem.de/fhem/trunk@3879 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/FHEM/00_HMLAN.pm | 172 ++++++++++++++++++++++++-------- fhem/FHEM/10_CUL_HM.pm | 216 ++++++++++++++++++++++++++++------------- fhem/FHEM/98_HMinfo.pm | 58 ++++++----- fhem/FHEM/HMConfig.pm | 2 +- 4 files changed, 319 insertions(+), 129 deletions(-) diff --git a/fhem/FHEM/00_HMLAN.pm b/fhem/FHEM/00_HMLAN.pm index 8d0d9eefe..d7e9d67c5 100755 --- a/fhem/FHEM/00_HMLAN.pm +++ b/fhem/FHEM/00_HMLAN.pm @@ -24,7 +24,6 @@ sub HMLAN_DoInit($); sub HMLAN_KeepAlive($); sub HMLAN_secSince2000(); sub HMLAN_relOvrLd($); -sub HMLAN_relOvrLd($); sub HMLAN_condUpdate($$); my $debug = 1; # set 1 for better log readability @@ -34,8 +33,10 @@ my %sets = ( "hmPairForSec" => "HomeMatic" my %HMcond = ( 0 =>'ok' ,2 =>'Warning-HighLoad' ,4 =>'ERROR-Overload' + ,253=>'disconnected' ,254=>'Overload-released' ,255=>'init'); + my $HMOvLdRcvr = 6*60;# time HMLAN needs to recover from overload sub HMLAN_Initialize($) { @@ -63,6 +64,7 @@ sub HMLAN_Initialize($) { "hmId hmKey " . "respTime wdStrokeTime:5,10,15,20,25 " . "hmProtocolEvents:0_off,1_dump,2_dumpFull,3_dumpTrigger ". + "hmLanQlen:1_min,2_low,3_normal,4_high,5_critical ". "wdTimer ". $readingFnAttributes; } @@ -87,7 +89,17 @@ sub HMLAN_Define($$) {######################################################### return undef; } $attr{$name}{wdTimer} = 25; + $attr{$name}{hmLanQlen} = "1_min"; #max message queue length in HMLan + no warnings 'numeric'; + $hash->{helper}{q}{hmLanQlen} = int($attr{$name}{hmLanQlen})+0; + use warnings 'numeric'; $hash->{DeviceName} = $dev; + + $hash->{helper}{q}{answerPend} = 0;#pending answers from LANIf + my @arr = (); + @{$hash->{helper}{q}{apIDs}} = \@arr; + + HMLAN_condUpdate($hash,253);#set disconnected my $ret = DevIo_OpenDev($hash, 0, "HMLAN_DoInit"); return $ret; } @@ -120,6 +132,16 @@ sub HMLAN_Attr(@) {################################# return "select wdTimer between 5 and 25 seconds" if ($aVal>25 || $aVal<5); $attr{$name}{wdTimer} = $aVal; } + elsif($attrName eq "hmLanQlen"){ + if ($cmd eq "set"){ + no warnings 'numeric'; + $defs{$name}{helper}{q}{hmLanQlen} = int($aVal)+0; + use warnings 'numeric'; + } + else{ + $defs{$name}{helper}{q}{hmLanQlen} = 1; + } + } return; } @@ -176,6 +198,7 @@ sub HMLAN_ReadAnswer($$$) {# This is a direct read for commands like get next if ($! == EAGAIN() || $! == EINTR() || $! == 0); my $err = $!; DevIo_Disconnected($hash); + HMLAN_condUpdate($hash,253); return("HMLAN_ReadAnswer $arg: $err", undef); } return ("Timeout reading answer for get $arg", undef) if($nfound == 0); @@ -346,8 +369,11 @@ sub HMLAN_Parse($$) {########################################################## # $CULinfo = "AESresp";# General needs approval } if ($stat){# message with status information - HMLAN_condUpdate($hash,$HMcnd)if ($hash->{helper}{HMcnd} != $HMcnd); + HMLAN_condUpdate($hash,$HMcnd)if ($hash->{helper}{q}{HMcndN} != $HMcnd); + if ($stat & 0x03 && $dst eq $attr{$name}{hmId}){HMLAN_qResp($hash,$src,0);} + elsif ($stat & 0x08 && $src eq $attr{$name}{hmId}){HMLAN_qResp($hash,$dst,0);} + $hash->{helper}{$dst}{flg} = 0;#got response => unblock sending if ($stat & 0x0A){#08 and 02 dont need to go to CUL, internal ack only Log $ll5, "HMLAN_Parse: $name no ACK from $dst" if($stat & 0x08); @@ -356,7 +382,7 @@ sub HMLAN_Parse($$) {########################################################## $CULinfo = "AESerrReject"; }elsif (($stat & 0x70) == 0x20){$CULinfo = "AESok"; }elsif (($stat & 0x70) == 0x40){;#$CULinfo = "???"; - } + } } my $rssi = hex($mFld[4])-65536; @@ -390,7 +416,7 @@ sub HMLAN_Parse($$) {########################################################## # we ack ourself an long as logic is uncertain - also possible is 'A6' for RHS if (hex($flg)&0x4){#not sure: 4 oder 2 ? my $wait = 0.100 - $dly/1000; - $hash->{helper}{nextSend}{$src} = gettimeofday() + $wait if ($wait > 0); + $hash->{helper}{$src}{nextSend} = gettimeofday() + $wait if ($wait > 0); } if (hex($flg)&0xA4 == 0xA4 && $hash->{owner} eq $dst){ Log $ll5, "HMLAN_Parse: $name ACK config"; @@ -418,8 +444,8 @@ sub HMLAN_Parse($$) {########################################################## $hash->{owner} = $mFld[4]; $hash->{uptime} = HMLAN_uptime($mFld[5],$hash); $hash->{assignIDsReport}=hex($mFld[6]); - $hash->{helper}{keepAliveRec} = 1; - $hash->{helper}{keepAliveRpt} = 0; + $hash->{helper}{q}{keepAliveRec} = 1; + $hash->{helper}{q}{keepAliveRpt} = 0; Log $ll5, 'HMLAN_Parse: '.$name. ' V:'.$mFld[1] .' sNo:'.$mFld[2].' d:'.$mFld[3] .' O:' .$mFld[4].' t:'.$mFld[5].' IDcnt:'.$mFld[6]; @@ -446,6 +472,8 @@ sub HMLAN_SimpleWrite(@) {##################################################### my ($hash, $msg, $nonl) = @_; return if(!$hash || AttrVal($hash->{NAME}, "dummy", undef)); + HMLAN_condUpdate($hash,253) if ($hash->{STATE} eq "disconnected");#closed? + my $name = $hash->{NAME}; my $ll5 = GetLogLevel($name,5); my $len = length($msg); @@ -453,34 +481,44 @@ sub HMLAN_SimpleWrite(@) {##################################################### # It is not possible to answer befor 100ms if ($len>51){ - return if($hash->{helper}{HMcnd} && $hash->{helper}{HMcnd} == 4);#overload + if($hash->{helper}{q}{HMcndN}){ + my $HMcnd = $hash->{helper}{q}{HMcndN}; + return if ($HMcnd == 4 || $HMcnd == 253);# no send if overload or disconnect + } + my $dst = substr($msg,46,6); - if ($hash->{helper}{nextSend}{$dst}){ - my $DevDelay = $hash->{helper}{nextSend}{$dst} - gettimeofday(); + my $hDst = $hash->{helper}{$dst};# shortcut + if ($hDst->{nextSend}){ + my $DevDelay = $hDst->{nextSend} - gettimeofday(); select(undef, undef, undef, (($DevDelay > 0.1)?0.1:$DevDelay)) if ($DevDelay > 0.01); - delete $hash->{helper}{nextSend}{$dst}; + delete $hDst->{nextSend}; } if ($dst ne $attr{$name}{hmId}){ #delay send if answer is pending - if ( $hash->{helper}{$dst}{flg} && #HMLAN's ack pending - ($hash->{helper}{$dst}{to} > gettimeofday())){#won't wait forever! - $hash->{helper}{$dst}{msg} = $msg; #postpone message + if ( $hDst->{flg} && #HMLAN's ack pending + ($hDst->{to} > gettimeofday())){#won't wait forever! + $hDst->{msg} = $msg; #postpone message Log $ll5,"HMLAN_Delay: $name $dst"; return; } my $flg = substr($msg,36,2); - $hash->{helper}{$dst}{flg} = (hex($flg)&0x20)?1:0; - $hash->{helper}{$dst}{to} = gettimeofday() + 2;# flag timeout after 2 sec - $hash->{helper}{$dst}{msg} = ""; + $hDst->{flg} = (hex($flg)&0x20)?1:0;# answer expected? + $hDst->{to} = gettimeofday() + 2;# flag timeout after 2 sec + $hDst->{msg} = ""; + + if ($hDst->{flg} == 1 && + substr($msg,40,6) eq $attr{$name}{hmId}){ + HMLAN_qResp($hash,$dst,1); + } } if ($len > 52){#channel information included, send sone kind of clearance my $chn = substr($msg,52,2); - if ($hash->{helper}{$dst}{chn} && $hash->{helper}{$dst}{chn} ne $chn){ - my $updt = $hash->{helper}{$dst}{newChn}; + if ($hDst->{chn} && $hDst->{chn} ne $chn){ + my $updt = $hDst->{newChn}; Log $ll5, 'HMLAN_Send: '.$name.' S:'.$updt; syswrite($hash->{TCPDev}, $updt."\r\n") if($hash->{TCPDev}); } - $hash->{helper}{$dst}{chn} = $chn; + $hDst->{chn} = $chn; } $msg =~ m/(.{9}).(..).(.{8}).(..).(.{8}).(..)(....)(.{6})(.{6})(.*)/; Log $ll5, 'HMLAN_Send: '.$name.' S:'.$1 @@ -519,12 +557,12 @@ sub HMLAN_DoInit($) {########################################################## HMLAN_SimpleWrite($hash, "T$s2000,04,00,00000000"); delete $hash->{helper}{ref}; - $hash->{helper}{HMcnd} = 0xff; # init HMLAN xmit cond, will force reading + HMLAN_condUpdate($hash,0xff); RemoveInternalTimer( "Overload:".$name); foreach (keys %lhash){delete ($lhash{$_})};# clear IDs - HMLAN might have a reset - $hash->{helper}{keepAliveRec} = 1; # ok for first time - $hash->{helper}{keepAliveRpt} = 0; # ok for first time + $hash->{helper}{q}{keepAliveRec} = 1; # ok for first time + $hash->{helper}{q}{keepAliveRpt} = 0; # ok for first time RemoveInternalTimer( "keepAliveCk:".$name);# avoid duplicate timer RemoveInternalTimer( "keepAlive:".$name);# avoid duplicate timer @@ -535,7 +573,7 @@ sub HMLAN_KeepAlive($) {####################################################### my($in ) = shift; my(undef,$name) = split(':',$in); my $hash = $defs{$name}; - $hash->{helper}{keepAliveRec} = 0; # reset indicator + $hash->{helper}{q}{keepAliveRec} = 0; # reset indicator return if(!$hash->{FD}); HMLAN_SimpleWrite($hash, "K"); @@ -550,17 +588,18 @@ sub HMLAN_KeepAliveCheck($) {################################################## my($in ) = shift; my(undef,$name) = split(':',$in); my $hash = $defs{$name}; - if ($hash->{helper}{keepAliveRec} != 1){# no answer - if ($hash->{helper}{keepAliveRpt} >2){# give up here + if ($hash->{helper}{q}{keepAliveRec} != 1){# no answer + if ($hash->{helper}{q}{keepAliveRpt} >2){# give up here DevIo_Disconnected($hash); + HMLAN_condUpdate($hash,253); } else{ - $hash->{helper}{keepAliveRpt}++; + $hash->{helper}{q}{keepAliveRpt}++; HMLAN_KeepAlive("keepAlive:".$name);#repeat } } else{ - $hash->{helper}{keepAliveRpt}=0; + $hash->{helper}{q}{keepAliveRpt}=0; } } @@ -575,26 +614,76 @@ sub HMLAN_secSince2000() {##################################################### - 7200; # HM Special return $t; } +sub HMLAN_qResp($$$) {#response-waiting queue################################## + my($hash,$id,$cmd) = @_; + my $hashQ = $hash->{helper}{q}; + if ($cmd){ + $hashQ->{answerPend} ++; + push @{$hashQ->{apIDs}},$id; + $hash->{XmitOpen} = 0 if ($hashQ->{answerPend} >= $hashQ->{hmLanQlen}); + } + else{ + $hashQ->{answerPend}-- if ($hashQ->{answerPend}>0); + @{$hashQ->{apIDs}}=grep !/$id/,@{$hashQ->{apIDs}}; + $hash->{XmitOpen} = 1 + if (($hashQ->{answerPend} < $hashQ->{hmLanQlen}) && + !($hashQ->{HMcndN} == 4 || + $hashQ->{HMcndN} == 253) + ); + } + +# Log 1,"General max:$hashQ->{hmLanQlen} cmd:$cmd" +# ."/".$hash->{XmitOpen} +# ." :".$hashQ->{answerPend} +# ."/".@{$hashQ->{apIDs}} +# .":".join("-",@{$hashQ->{apIDs}}) +# .":$debug" ; +} sub HMLAN_relOvrLd($) {######################################################## my(undef,$name) = split(':',$_[0]); HMLAN_condUpdate($defs{$name},0xFE); + $defs{$name}{STATE} = "opened"; } sub HMLAN_condUpdate($$) {##################################################### my($hash,$HMcnd) = @_; my $name = $hash->{NAME}; - $hash->{helper}{cnd}{$HMcnd} = 0 if (!$hash->{helper}{cnd}{$HMcnd}); - $hash->{helper}{cnd}{$HMcnd}++; - InternalTimer(gettimeofday()+$HMOvLdRcvr,"HMLAN_relOvrLd","Overload:".$name,1) - if ($HMcnd == 4); + my $hashCnd = $hash->{helper}{cnd};#short to helper + my $hashQ = $hash->{helper}{q};#short to helper + $hashCnd->{$HMcnd} = 0 if (!$hashCnd->{$HMcnd}); + $hashCnd->{$HMcnd}++; + if ($HMcnd == 4){#HMLAN needs a rest. Supress all sends exept keep alive + InternalTimer(gettimeofday()+$HMOvLdRcvr,"HMLAN_relOvrLd","Overload:".$name,1); + $hash->{STATE} = "overload"; + } my $HMcndTxt = $HMcond{$HMcnd}?$HMcond{$HMcnd}:"Unknown:$HMcnd"; Log GetLogLevel($name,2), "HMLAN_Parse: $name new condition $HMcndTxt"; - readingsSingleUpdate($hash,"cond",$HMcndTxt,1); my $txt; - $txt .= $HMcond{$_}.":".$hash->{helper}{cnd}{$_}." " - foreach (keys%{$hash->{helper}{cnd}}); - readingsSingleUpdate($hash,"Xmit-Events",$txt,1); - $hash->{helper}{HMcnd} = $HMcnd; + $txt .= $HMcond{$_}.":".$hashCnd->{$_}." " + foreach (keys%{$hashCnd}); + + readingsBeginUpdate($hash); + readingsBulkUpdate($hash,"cond",$HMcndTxt); + readingsBulkUpdate($hash,"Xmit-Events",$txt); + readingsBulkUpdate($hash,"prot_".$HMcndTxt,"last"); + readingsEndUpdate($hash,1); + + $hashQ->{HMcndN} = $HMcnd; + + if ($HMcnd == 4 || $HMcnd == 253) {#transmission down + $hashQ->{answerPend} = 0; + @{$hashQ->{apIDs}} = (); #clear Q-status + $hash->{XmitOpen} = 0; #deny transmit + } + elsif ($HMcnd == 255) {#reset counter after init + $hashQ->{answerPend} = 0; + @{$hashQ->{apIDs}} = (); #clear Q-status + $hash->{XmitOpen} = 1; #deny transmit + } + else{ + $hash->{XmitOpen} = 1 + if($hashQ->{answerPend} < $hashQ->{hmLanQlen});#allow transmit + } } 1; @@ -660,9 +749,16 @@ sub HMLAN_condUpdate($$) {##################################################### Define max response time of the HMLAN adapter in seconds. Default is 1 sec.
Longer times may be used as workaround in slow/instable systems or LAN configurations.
  • wdTimer
    - Time in sec to trigger HMLAN. Values between 5 and 25 are allowed, 25 is default.
    - It is not recommended to change this timer. If problems are detected with
    + Time in sec to trigger HMLAN. Values between 5 and 25 are allowed, 25 is default.
    + It is not recommended to change this timer. If problems are detected with
    HLMLAN disconnection it is advisable to resolve the root-cause of the problem and not symptoms.
    • +
  • hmLanQlen
    + defines queuelength of HMLAN interface. This is therefore the number of + simultanously send messages. increasing values may cause higher transmission speed. + It may also cause retransmissions up to data loss.
    + Effects can be observed by watching protocol events
    + 1 - is a conservatibe value, and is default
    + 5 - is critical length, likely cause message loss
    • diff --git a/fhem/FHEM/10_CUL_HM.pm b/fhem/FHEM/10_CUL_HM.pm index e1a04e987..68870cf67 100755 --- a/fhem/FHEM/10_CUL_HM.pm +++ b/fhem/FHEM/10_CUL_HM.pm @@ -117,6 +117,12 @@ sub CUL_HM_putHash($); # ----------------modul globals----------------------- my $respRemoved; # used to control trigger of stack processing +my $IOpoll = 0.2;# poll speed to scan IO device out of order +my $IOpolltout = 60; # poll timeout - stop poll and discard if to late + +my $maxPendCmds = 10; #number of parallel requests +my $autoConfDly = 5; # delay autoConf readings + # need to take care that ACK is first #+++++++++++++++++ startup, init, definition+++++++++++++++++++++++++++++++++++ sub CUL_HM_Initialize($) { @@ -148,10 +154,14 @@ sub CUL_HM_Initialize($) { $hash->{AttrList} .= " model:" .join(",", sort @modellist); $hash->{AttrList} .= " subType:".join(",", CUL_HM_noDup(map { $culHmModel{$_}{st} } keys %culHmModel)); + + $hash->{prot}{rspPend} = 0;#count Pending responses + CUL_HM_initRegHash(); } sub CUL_HM_reqStatus($){ + return if(!defined$modules{CUL_HM}{helper}{reqStatus}); while(@{$modules{CUL_HM}{helper}{reqStatus}}){ my $name = shift(@{$modules{CUL_HM}{helper}{reqStatus}}); CUL_HM_Set($defs{$name},$name,"statusRequest"); @@ -171,7 +181,9 @@ sub CUL_HM_autoReadConfig($){ CUL_HM_Set($hash,$name,"getSerial"); CUL_HM_Set($hash,$name,"getConfig"); CUL_HM_Set($hash,$name,"statusRequest"); - InternalTimer(gettimeofday()+15,"CUL_HM_autoReadConfig","autoRdCfg",0); + InternalTimer(gettimeofday()+$autoConfDly + ,"CUL_HM_autoReadConfig" + ,"autoRdCfg",0); last; } } @@ -542,7 +554,6 @@ sub CUL_HM_Parse($$) {############################## return $name; #return something to please dispatcher } $shash->{lastMsg} = $msgX; -# $iohash->{HM_CMDNR} = hex($mNo) if($dst eq $id);# updt message cnt to rec delete $shash->{helper}{rpt};# new message, rm recent ack my @ack; # ack and responses, might be repeated @@ -553,10 +564,15 @@ sub CUL_HM_Parse($$) {############################## push @event, "powerOn" if($parse eq "powerOn"); push @event, "" if($parse eq "parsed"); # msg is parsed but may # be processed further - if ($parse =~ s/entities://){#common generated trigger for some entities - push @entities,split(",",$parse); + foreach my $r (split";",$parse){ + if ($r =~ s/entities://){#common generated trigger for some entities + push @entities,split(",",$r); + } + else{ + $parse = $r; + } } - + if ($parse eq "ACK"){# remember - ACKinfo will be passed on push @event, ""; } @@ -904,12 +920,8 @@ sub CUL_HM_Parse($$) {############################## my $chId = $src.$chn; $shash = $modules{CUL_HM}{defptr}{$chId} if($modules{CUL_HM}{defptr}{$chId}); - if ($err&0x40 && $chn eq "02"){ - push @event, "timedOn:running"; - } - else{ - push @event, "timedOn:off"; - } + + push @event, "timedOn:".(($err&0x40 && $chn eq "02")?"running":"off"); my $mdCh = $md.$chn; if($lvlStr{mdCh}{$mdCh} && $lvlStr{mdCh}{$mdCh}{$val}){ @@ -1016,12 +1028,8 @@ sub CUL_HM_Parse($$) {############################## $eventName = "motor" if($st eq "blindActuator"); $eventName = "dim" if($st eq "dimmer"); my $action; #determine action - if ($err&0x40){ - push @event, "timedOn:running"; - } - else{ - push @event, "timedOn:off" if ($shash->{READINGS}{timedOn}); - } + push @event, "timedOn:".($err&0x40)?"running":"off"; + if ($st ne "switch"){ push @event, "$eventName:up:$vs" if(($err&0x30) == 0x10); push @event, "$eventName:down:$vs" if(($err&0x30) == 0x20); @@ -1537,19 +1545,16 @@ sub CUL_HM_parseCommon(@){##################################################### if ($rssi && $rssi ne '00' && $rssi ne'80'); $reply = "ACKStatus"; if ($shash->{helper}{tmdOn}){ - my $timedOn = hex(substr($p,6,2))&0x40?1:0; - if (not hex(substr($p,6,2))&0x40){# not timed on, we have to repeat + if (not hex(substr($p,6,2))&0x40){# not timedOn, we have to repeat my ($pre,$nbr,$msg) = unpack 'A4A2A*',$shash->{helper}{respWait}{cmd}; - $shash->{helper}{respWait}{cmd} = sprintf("%s%02X%s",$pre,hex($nbr)+1,$msg); - # General changes pending aproval -# CUL_HM_eventP($shash,"TimedOn"); -# $success = "no"; -# $repeat = 1; -# $reply = "NACK"; - Log 1,"General missed timedOn for ".$chnhash->{NAME}; + $shash->{helper}{respWait}{cmd} = sprintf("%s%02X%s", + $pre,hex($nbr)+1,$msg); + CUL_HM_eventP($shash,"TimedOn"); + $success = "no"; + $repeat = 1; + $reply = "NACK"; } } - } else{ #ACK $success = "yes"; @@ -1592,7 +1597,7 @@ sub CUL_HM_parseCommon(@){##################################################### CUL_HM_ID2PeerList ($chnNname,$_,1) foreach (@peers); if (grep /00000000/,@peers) {# last entry, peerList is complete - CUL_HM_respPendRm($shash); + CUL_HM_respPendRm($shash); # check for request to get List3 data my $reqPeer = $chnhash->{helper}{getCfgList}; if ($reqPeer){ @@ -1664,10 +1669,14 @@ sub CUL_HM_parseCommon(@){##################################################### CUL_HM_updtRegDisp($chnHash,$list, CUL_HM_peerChId($peer, substr($chnHash->{DEF},0,6),"00000000")); + $ret = "done;entities:$chnName"; } else{ CUL_HM_respPendToutProlong($shash);#wasn't last - reschedule timer + $ret = "done"; } + } + else{#response without request - discard $ret = "done"; } } @@ -1868,13 +1877,11 @@ sub CUL_HM_Get($@) { my @regValList; #storage of results my $regHeader = "list:peer\tregister :value\n"; foreach my $regName (@regArr){ - Log 1,"Gegeral process $regName"; my $regL = $culHmRegDefine{$regName}->{l}; my @peerExe = (grep (/$regL/,@listWp))?@peers:("00000000"); foreach my $peer(@peerExe){ next if($peer eq ""); my $regVal= CUL_HM_getRegFromStore($name,$regName,0,$peer);#determine - Log 1,"Gegeral get $regName p:$peer v:$regVal"; my $peerN = CUL_HM_id2Name($peer); $peerN = " " if ($peer eq "00000000"); push @regValList,sprintf(" %d:%s\t%-16s :%s\n", @@ -2013,6 +2020,7 @@ sub CUL_HM_Set($@) { my @h; @h = split(" ", $h) if($h); + my @postCmds=(); #Commands to be appended after regSet (ugly...) if(!defined($h) && defined($culHmSubTypeSets{$st}{pct}) && $cmd =~ m/^\d+/) { splice @a, 1, 0,"pct";#insert the actual command @@ -2091,13 +2099,14 @@ sub CUL_HM_Set($@) { } elsif($cmd =~ m /(displayMode|displayTemp|displayTempUnit|controlMode|decalcDay)/) { splice @a,1,3, ("regSet",$a[1],$a[2]); + push @postCmds,"++803F$id${dst}0204".sprintf("%02X",CUL_HM_secSince2000()); } elsif($cmd eq "partyMode") { ################################################ my $days = $a[3]; my ($eH,$eM) = split(':',$a[2]); return "use 00 or 30 minutes only" if ($eM !~ m/^(00|30)$/); return "hour must be between 0 and 23" if ($eH lt 0 || $eH gt 23); - return "days must be between 0 and 200" if ($days lt 0 || $days gt 200); + return "days must be between 0 and 200" if ($days < 0 || $days > 200); $eH += 128 if ($eM eq "30"); my $cHash = CUL_HM_id2Hash($dst."02"); $cHash->{helper}{partyReg} = sprintf("61%02X62%02X0000",$eH,$days); @@ -2113,6 +2122,7 @@ sub CUL_HM_Set($@) { CUL_HM_pushConfig($hash,$id,$dst,2,"000000","00",6, sprintf("61%02X62%02X",$eH,$days)); splice @a,1,3, ("regSet","controlMode","party"); + push @postCmds,"++803F$id${dst}0204".sprintf("%02X",CUL_HM_secSince2000()); } $cmd = $a[1];# get converted command @@ -2136,7 +2146,8 @@ sub CUL_HM_Set($@) { delete $hash->{READINGS}; } elsif($sect eq "msgEvents"){ - CUL_HM_respPendRm($hash); + CUL_HM_respPendRm($hash); + delete ($hash->{helper}{burstEvtCnt}); delete ($hash->{cmdStack}); delete ($hash->{EVENTS}); @@ -2144,6 +2155,11 @@ sub CUL_HM_Set($@) { my $protLastRcv = $hash->{protLastRcv} if ($hash->{protLastRcv}); delete ($hash->{$_}) foreach (grep(/^prot/,keys %{$hash})); $hash->{protLastRcv} = $protLastRcv if ($protLastRcv); + if ($modules{CUL_HM}{$hash->{IODev}{NAME}} && + $modules{CUL_HM}{$hash->{IODev}{NAME}}{pendDev}){ + @{$modules{CUL_HM}{$hash->{IODev}{NAME}}{pendDev}} = + grep !/$name/,@{$modules{CUL_HM}{$hash->{IODev}{NAME}}{pendDev}}; + } CUL_HM_protState($hash,"Info_Cleared"); } elsif($sect eq "rssi"){ @@ -2352,6 +2368,8 @@ sub CUL_HM_Set($@) { $cHash = $hash if (!$cHash); CUL_HM_pushConfig($cHash,$id,$dst,$lChn,$peerId,hex($peerChn),$list ,$addrData,$prep); + + CUL_HM_PushCmdStack($hash,$_) foreach(@postCmds);#ugly commands after regSet } elsif($cmd eq "level") { #################################################### #level =>" ..." @@ -2371,9 +2389,6 @@ sub CUL_HM_Set($@) { elsif($cmd =~ m/^(on|off|toggle)$/) { ####################################### my $lvl = ($cmd eq 'on') ? 'C8': (($cmd eq 'off') ? '00':(CUL_HM_getChnLvl($name) != 0 ?"00":"C8")); - if($st eq "blindActuator") { # need to stop blind to protect relais - CUL_HM_PushCmdStack($hash,'++'.$flag.'11'.$id.$dst.'03'.$chn) - } CUL_HM_PushCmdStack($hash,"++$flag"."11$id$dst"."02$chn$lvl".'0000'); $hash = $chnHash; # report to channel if defined } @@ -2425,9 +2440,6 @@ sub CUL_HM_Set($@) { $tval = $a[3]?CUL_HM_encodeTime16($a[3]):"FFFF";# onTime 0.05..85825945.6, 0=forever $rval = CUL_HM_encodeTime16((@a > 4)?$a[4]:2.5);# rampTime 0.0..85825945.6, 0=immediate } - elsif($st eq "blindActuator") { # need to stop blind to protect relais - CUL_HM_PushCmdStack($hash,'++'.$flag.'11'.$id.$dst.'03'.$chn) - } CUL_HM_PushCmdStack($hash,sprintf("++%s11%s%s02%s%02X%s%s", $flag,$id,$dst,$chn,$lvl*2,$rval,$tval)); readingsSingleUpdate($hash,"level","set_".$lvl,1); @@ -2797,7 +2809,8 @@ sub CUL_HM_Set($@) { } else{#serve internal channels for actor my $pChn = $chn; # simple device, only one button per channel - $pChn = (($vChn && $vChn eq "off")?-1:0) + $chn*2 if($st eq 'blindActuator'||$st eq 'dimmer'); + $pChn = (($vChn && $vChn eq "off")?-1:0) + $chn*2 + if($st eq 'blindActuator'||$st eq 'dimmer'); CUL_HM_PushCmdStack($hash, sprintf("++%s3E%s%s%s40%02X%02X",$flag, $id,$dst,$dst, $pChn+(($mode && $mode eq "long")?64:0), @@ -3053,16 +3066,81 @@ sub CUL_HM_getConfig($$$$$){ } #+++++++++++++++++ Protocol stack, sending, repeat+++++++++++++++++++++++++++++ +sub CUL_HM_sndIfOpen($) { + my(undef,$io) = split(':',$_[0]); + RemoveInternalTimer("sndIfOpen:$io");# should not be necessary, but + my $ioHash = $defs{$io}; + if ( $ioHash->{STATE} ne "opened" + ||(defined $ioHash->{XmitOpen} && $ioHash->{XmitOpen} == 0) +# ||$modules{CUL_HM}{prot}{rspPend}>=$maxPendCmds + ){#still no send allowed + if ($modules{CUL_HM}{$io}{tmrStart} < gettimeofday() - $IOpolltout){ + # we need to clean up - this is way to long Stop delay + if ($modules{CUL_HM}{$io}{pendDev}) { + while(@{$modules{CUL_HM}{$io}{pendDev}}){ + my $name = shift(@{$modules{CUL_HM}{$io}{pendDev}}); + CUL_HM_eventP($defs{$name},"IOerr"); + } + } + $modules{CUL_HM}{$io}{tmr} = 0; + } + else{ + InternalTimer(gettimeofday()+$IOpoll,"CUL_HM_sndIfOpen", + "sndIfOpen:$io", 0); + } + } + else{ + $modules{CUL_HM}{$io}{tmr} = 0; + my $name = shift(@{$modules{CUL_HM}{$io}{pendDev}}); + CUL_HM_ProcessCmdStack($defs{$name}); + if (@{$modules{CUL_HM}{$io}{pendDev}}){#tmr = 0, clearing queue slowly + InternalTimer(gettimeofday()+$IOpoll,"CUL_HM_sndIfOpen", + "sndIfOpen:$io", 0); + } + } +} sub CUL_HM_SndCmd($$) { my ($hash, $cmd) = @_; $hash = CUL_HM_getDeviceHash($hash); my $io = $hash->{IODev}; return if(!$io); - if ($io->{helper}{HMcnd} && $io->{helper}{HMcnd} == 4){#io in overload, dont send - CUL_HM_eventP($hash,"IOerr"); + my $ioName = $io->{NAME}; + if ((hex substr($cmd,2,2) & 0x20) && ( # check for commands with resp-req + $io->{STATE} ne "opened" # we need to queue + || $modules{CUL_HM}{$ioName}{tmr} # queue already running + ||(defined $io->{XmitOpen} && $io->{XmitOpen} == 0)#overload, dont send +# ||$modules{CUL_HM}{prot}{rspPend}>=$maxPendCmds + ) + ){ + + # shall we delay commands if IO device is not present? + # it could cause trouble if light switches on after a long period + # repetition will be stopped after 1min forsecurity reason. + my @arr = (); + $hash->{cmdStack} = \@arr if(!$hash->{cmdStack}); + unshift (@{$hash->{cmdStack}}, $cmd);#pushback cmd, wait for opportunitiy + + # push device to list + if (!defined $modules{CUL_HM}{$ioName}{tmr}){ + # some setup work for this timer + $modules{CUL_HM}{$ioName}{tmr} = 0; + my @arr2 = (); + $modules{CUL_HM}{$ioName}{pendDev} = \@arr2 + if (!$modules{CUL_HM}{$ioName}{pendDev}); + } + @{$modules{CUL_HM}{$ioName}{pendDev}} = + CUL_HM_noDup(@{$modules{CUL_HM}{$ioName}{pendDev}},$hash->{NAME}); + CUL_HM_respPendRm($hash);#rm timer - we are out + + if ($modules{CUL_HM}{$ioName}{tmr} != 1){# need to stat timer + my $tn = gettimeofday(); + InternalTimer($tn+$IOpoll, "CUL_HM_sndIfOpen", "sndIfOpen:$ioName", 0); + $modules{CUL_HM}{$ioName}{tmr} = 1; + $modules{CUL_HM}{$ioName}{tmrStart} = $tn; # abort if to long + } return; } - + $cmd =~ m/^(..)(.*)$/; my ($mn, $cmd2) = ($1, $2); @@ -3079,28 +3157,37 @@ sub CUL_HM_SndCmd($$) { } $cmd = sprintf("As%02X%02X%s", length($cmd2)/2+1, $mn, $cmd2); IOWrite($hash, "", $cmd); + CUL_HM_eventP($hash,"Snd"); CUL_HM_responseSetup($hash,$cmd); $cmd =~ m/As(..)(..)(..)(..)(......)(......)(.*)/; CUL_HM_DumpProtocol("SND", $io, ($1,$2,$3,$4,$5,$6,$7)); } +sub CUL_HM_respWaitSu ($@){ #setup response for multi-message response + my ($hash,@a)=@_; + my $hashW = $hash->{helper}{respWait}; + $modules{CUL_HM}{prot}{rspPend}++ if(!$hashW->{PendCmd} && + !$hashW->{cmd}); + foreach (@a){ + my ($f,$d)=split ":",$_; + $hashW->{$f}=$d; + } + if ($hashW->{cmd}){InternalTimer(gettimeofday()+rand(40)/10+1,"CUL_HM_Resend" , $hash, 0);} + else{ InternalTimer(gettimeofday()+rand(20)/10+4,"CUL_HM_respPendTout","respPend:$hash->{DEF}", 0);} +} sub CUL_HM_responseSetup($$) {#store all we need to handle the response #setup repeatTimer and cmdStackControll my ($hash,$cmd) = @_; my ($mNo,$mFlg,$mTp,$dst,$p) = ($2,hex($3),$4,$6,$7) if ($cmd =~ m/As(..)(..)(..)(..)(......)(......)(.*)/); my ($chn,$subType) = ($1,$2) if($p =~ m/^(..)(..)/); - my $rTo = rand(20)/10+4; #default response timeout +# my $rTo = rand(20)/10+4; #default response timeout if (($mFlg & 0x20) && ($dst ne '000000')){ if ($mTp eq "01" && $subType){ if ($subType eq "03"){ #PeerList------------- #--- remember request params in device level - $hash->{helper}{respWait}{Pending} = "PeerList"; - $hash->{helper}{respWait}{PendCmd} = $cmd; - $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); - + CUL_HM_respWaitSu ($hash,"Pending:PeerList" + ,"PendCmd:$cmd" ,"forChn:".substr($p,0,2)); + #--- remove readings in channel my $chnhash = $modules{CUL_HM}{defptr}{"$dst$chn"}; $chnhash = $hash if (!$chnhash); @@ -3114,14 +3201,9 @@ sub CUL_HM_responseSetup($$) {#store all we need to handle the response my ($peer, $list) = ($1,$2) if ($p =~ m/..04(........)(..)/); $peer = ($peer ne "00000000")?CUL_HM_peerChName($peer,$dst,""):""; #--- set messaging items - $hash->{helper}{respWait}{Pending}= "RegisterRead"; - $hash->{helper}{respWait}{PendCmd}= $cmd; - $hash->{helper}{respWait}{forChn} = $chn; - $hash->{helper}{respWait}{forList}= $list; - $hash->{helper}{respWait}{forPeer}= $peer; - - # define timeout - holdup cmdStack until response complete or timeout - InternalTimer(gettimeofday()+$rTo,"CUL_HM_respPendTout","respPend:$dst", 0); + CUL_HM_respWaitSu ($hash,"Pending:RegisterRead" + ,"PendCmd:$cmd" ,"forChn:$chn" + ,"forList:$list","forPeer:$peer"); #--- remove channel entries that will be replaced my $chnhash = $modules{CUL_HM}{defptr}{"$dst$chn"}; $chnhash = $hash if(!$chnhash); @@ -3147,16 +3229,13 @@ sub CUL_HM_responseSetup($$) {#store all we need to handle the response elsif($mTp eq '11' && $chn =~ m/^(02|81)$/){#!!! chn is subtype!!! CUL_HM_qStateUpdatIfEnab($dst); } - if ($mTp eq "11" && $p =~ m/02........(....)/){ - $hash->{helper}{tmdOn} = $1 if ($1 ne "0000"); + if ($mTp eq "11" && $p =~ m/02..(..)....(....)/){#lvl ne 0 and timer on + $hash->{helper}{tmdOn} = $2 if ($1 ne "00" && $2 != m/(0000|FFFF)/); } - $hash->{helper}{respWait}{cmd} = $cmd; - $hash->{helper}{respWait}{mNo} = $mNo; #mNo we wait to ack - $hash->{helper}{respWait}{reSent} = 1; - - InternalTimer(gettimeofday()+rand(40)/10+1, "CUL_HM_Resend", $hash, 0); - CUL_HM_protState($hash,"CMDs_processing..."); + CUL_HM_respWaitSu ($hash,"cmd:$cmd","mNo:$mNo","reSent:1"); + + CUL_HM_protState($hash,"CMDs_processing..."); } else{# no answer expected if($hash->{cmdStack} && scalar @{$hash->{cmdStack}}){ @@ -3218,6 +3297,8 @@ sub CUL_HM_protState($$){ } sub CUL_HM_respPendRm($) {#del response related entries in messageing entity my ($hash) = @_; + $modules{CUL_HM}{prot}{rspPend}-- if( $hash->{helper}{respWait}{cmd} + ||$hash->{helper}{respWait}{PendCmd}); delete ($hash->{helper}{respWait}); delete $hash->{helper}{tmdOn}; RemoveInternalTimer($hash); # remove resend-timer @@ -3232,7 +3313,7 @@ sub CUL_HM_respPendTout($) { my $pendCmd = $hash->{helper}{respWait}{Pending};# secure before remove my $pendRsndCnt = $hash->{helper}{respWait}{PendingRsend}; - $pendRsndCnt = 1 if (!$pendRsndCnt); + $pendRsndCnt = 1 if (!$pendRsndCnt); #already one send done if ($pendRsndCnt < 5 && # some retries (CUL_HM_getRxType($hash) & 0x03) != 0){# to slow for wakeup and config my $name = $hash->{NAME}; @@ -3276,7 +3357,6 @@ sub CUL_HM_ProcessCmdStack($) { !$hash->{helper}{respWait}{Pending}){ if(@{$hash->{cmdStack}}) { CUL_HM_SndCmd($hash, shift @{$hash->{cmdStack}}); - CUL_HM_eventP($hash,"Snd"); } elsif(!@{$hash->{cmdStack}}) { delete($hash->{cmdStack}); diff --git a/fhem/FHEM/98_HMinfo.pm b/fhem/FHEM/98_HMinfo.pm index 0f2d61baa..e59704d13 100644 --- a/fhem/FHEM/98_HMinfo.pm +++ b/fhem/FHEM/98_HMinfo.pm @@ -264,22 +264,39 @@ sub HMinfo_SetFn($@) {######################################################### } elsif($cmd eq "protoEvents"){##print protocol-events------------------------- my @paramList; + my @IOlist; foreach my $dName (HMinfo_getEntities($opt."dv",$filter)){ my $id = $defs{$dName}{DEF}; - my ($found,$para) = HMinfo_getParam($id,"protState","protCmdPend","protSnd", - "protLastRcv","protResndFail","protResnd","protNack"); + my ($found,$para) = HMinfo_getParam($id + ,"protState","protCmdPend" + ,"protSnd","protLastRcv","protResnd" + ,"protResndFail","protNack","protIOerr"); $para =~ s/( last_at|20..-|\|)//g; my @pl = split "\t",$para; $_ =~ s/\s+$|//g foreach (@pl); - $para = sprintf("%-20s%-22s|%-18s|%-18s|%-14s|%-18s|%-18s|%-18s", - $pl[0],$pl[1],$pl[2],$pl[3],$pl[4],$pl[5],$pl[6],$pl[7]); - push @paramList,$para; + push @paramList, sprintf("%-20s%-22s|%-18s|%-18s|%-14s|%-18s|%-18s|%-18s|%-18s", + $pl[0],$pl[1],$pl[2],$pl[3],$pl[4],$pl[5],$pl[6],$pl[7],$pl[8]); + push @IOlist,$defs{$pl[0]}{IODev}->{NAME}; } - my $hdr = sprintf("%-20s:%-21s|%-18s|%-18s|%-14s|%-18s|%-18s|%-18s", - "name","protState","protCmdPend","protSnd", - "protLastRcv","protResndFail","protResnd","protNack"); + my $hdr = sprintf("%-20s:%-21s|%-18s|%-18s|%-14s|%-18s|%-18s|%-18s|%-18s", + ,"name" + ,"protState","protCmdPend" + ,"protSnd","protLastRcv","protResnd" + ,"protResndFail","protNack","protIOerr"); $ret = $cmd." done:" ."\n ".$hdr ."\n ".(join "\n ",sort @paramList) ; + $ret .= "\n\n CUL_HM queue:$modules{CUL_HM}{prot}{rspPend}"; + $ret .= "\n autoRegRead pending:". + join(",",@{$modules{CUL_HM}{helper}{autoRdCfgLst}}) + if ($modules{CUL_HM}{helper}{autoRdCfgLst}); + @IOlist = HMinfo_noDup(@IOlist); + foreach(@IOlist){ + $_ .= ":".$defs{$_}{STATE}. + (defined $defs{$_}{helper}{q}{answerPend}? + " pending=".$defs{$_}{helper}{q}{answerPend} : + ""); + } + $ret .= "\n IODevs:".(join"\n ",HMinfo_noDup(@IOlist)); } elsif($cmd eq "rssi") {##print RSSI protocol-events-------------------- my @rssiList; @@ -642,18 +659,13 @@ sub HMinfo_status($){########################################################## push @updates,"ERR_$read:".$d; } - my %allE; # remove duplicates - $allE{$_}=0 foreach (grep !//, @errNames); - @errNames = sort keys %allE; + @errNames = grep !/^$/,HMinfo_noDup(@errNames); $hash->{ERR_names} = join",",@errNames if(@errNames);# and name entities -# push @updates,":".$hash->{ERR_names} if(@errNames); push @updates,"C_sumDefined:"."entities:$nbrE device:$nbrD channel:$nbrC virtual:$nbrV"; # ------- display status of action detector ------ push @updates,"I_actTotal:".$modules{CUL_HM}{defptr}{"000000"}{STATE}; -# push @updates,"ERR_actTotal:".$modules{CUL_HM}{defptr}{"000000"}{STATE}; $hash->{ERRactNames} = join",",@Anames if (@Anames); -# push @updates,":".$hash->{ERRactNames} if(@Anames); # ------- what about IO devices??? ------ my %tmp; # remove duplicates @@ -664,7 +676,6 @@ sub HMinfo_status($){########################################################## $_ .= " :".$defs{$_}{READINGS}{cond}{VAL}; } $hash->{I_HM_IOdevices}= join",",@IOdev; -# push @updates,":".$hash->{I_HM_IOdevices}; # ------- what about protocol events ------ # Current Events are Rcv,NACK,IOerr,Resend,ResendFail,Snd @@ -676,16 +687,11 @@ sub HMinfo_status($){########################################################## push @tpw,"$_:$protW{$_}" foreach (grep {$protW{$_}} keys(%protW)); push @updates,"W__protocol:".join",",@tpw if(@tpw); - my %all; # remove duplicates - $all{$_}=0 foreach (grep !//,@protNamesE); - @protNamesE = sort keys %all; + @protNamesE = grep !/^$/,HMinfo_noDup(@protNamesE);; $hash->{ERR__protoNames} = join",",@protNamesE if(@protNamesE); -# push @updates,":".$hash->{ERR__protoNames} if(@protNamesE); - $all{$_}=0 foreach (grep !//,@protNamesW); - @protNamesW = sort keys %all; + @protNamesW = grep !/^$/,HMinfo_noDup(@protNamesW); $hash->{W__protoNames} = join",",@protNamesW if(@protNamesW); -# push @updates,":".$hash->{W__protoNames} if(@protNamesW); if (defined $modules{CUL_HM}{helper}{autoRdCfgLst} && @{$modules{CUL_HM}{helper}{autoRdCfgLst}}>0){ @@ -1054,6 +1060,14 @@ sub HMinfo_cpRegs(@){######################################################### my ($ret,undef) = CUL_HM_Set($defs{$dstCh},$dstCh,"regBulk",$srcRegLn,split(" ",$srcData)); return $ret; } +sub HMinfo_noDup(@) {#return list with no duplicates + my %all; + return "" if (scalar(@_) == 0); + $all{$_}=0 foreach (grep !/^$/,@_); + delete $all{""}; #remove empties if present + return (sort keys %all); +} + 1; =pod =begin html diff --git a/fhem/FHEM/HMConfig.pm b/fhem/FHEM/HMConfig.pm index e7d7cec11..981b61abd 100644 --- a/fhem/FHEM/HMConfig.pm +++ b/fhem/FHEM/HMConfig.pm @@ -458,7 +458,7 @@ my %culHmRegDefine = ( useCustom =>{a=>110.0,s=>1 ,l=>1,min=>110,max=>310 ,c=>'lit' ,f=>'' ,u=>'' ,d=>1,t=>"use custom" ,lit=>{off=>0,on=>1}}, evtFltrPeriod =>{a=> 1.0,s=>0.4,l=>1,min=>0.5,max=>7.5 ,c=>'' ,f=>2 ,u=>'s' ,d=>1,t=>"event filter period"}, - evtFltrNum =>{a=> 1.4,s=>0.4,l=>1,min=>1 ,max=>15 ,c=>'' ,f=>'' ,u=>'' ,d=>1,t=>"sensitivity - read sach n-th puls"}, + evtFltrNum =>{a=> 1.4,s=>0.4,l=>1,min=>1 ,max=>15 ,c=>'' ,f=>'' ,u=>'' ,d=>1,t=>"sensitivity - read each n-th puls"}, minInterval =>{a=> 2.0,s=>0.3,l=>1,min=>0 ,max=>4 ,c=>'lit' ,f=>'' ,u=>'' ,d=>1,t=>"minimum interval in sec" ,lit=>{15=>0,30=>1,60=>2,120=>3,240=>4}}, captInInterval =>{a=> 2.3,s=>0.1,l=>1,min=>0 ,max=>1 ,c=>'lit' ,f=>'' ,u=>'' ,d=>1,t=>"capture within interval" ,lit=>{off=>0,on=>1}}, brightFilter =>{a=> 2.4,s=>0.4,l=>1,min=>0 ,max=>7 ,c=>'' ,f=>'' ,u=>'' ,d=>1,t=>"brightness filter - ignore light at night"},