mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-01-31 12:49:34 +00:00
introduce flow contorl for HMLAN
git-svn-id: https://svn.fhem.de/fhem/trunk@3879 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
martinp876
parent
bfe4c032f6
commit
ae8482245a
@ -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.<br/>
|
||||
Longer times may be used as workaround in slow/instable systems or LAN configurations.</li>
|
||||
<li><a href="#wdTimer">wdTimer</a><br>
|
||||
Time in sec to trigger HMLAN. Values between 5 and 25 are allowed, 25 is default.<br/>
|
||||
It is <B>not recommended</B> to change this timer. If problems are detected with <br/>
|
||||
Time in sec to trigger HMLAN. Values between 5 and 25 are allowed, 25 is default.<br>
|
||||
It is <B>not recommended</B> to change this timer. If problems are detected with <br>
|
||||
HLMLAN disconnection it is advisable to resolve the root-cause of the problem and not symptoms.</li>
|
||||
<li><a href="#hmLanQlen">hmLanQlen</a><br>
|
||||
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.<br>
|
||||
Effects can be observed by watching protocol events<br>
|
||||
1 - is a conservatibe value, and is default<br>
|
||||
5 - is critical length, likely cause message loss</li>
|
||||
</ul>
|
||||
</ul>
|
||||
|
||||
|
||||
@ -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 =>"<level> <relockDly> <speed>..."
|
||||
@ -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});
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"},
|
||||
|
||||
Loading…
Reference in New Issue
Block a user