FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-03-10 09:16:53 +00:00
Code Issues Releases Wiki Activity

obey status 04xx, provide alarms and quiet period

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@3313 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
martinp876 2013-06-22 16:05:58 +00:00
parent c17f885f98
commit 36eaa41f7a
2 changed files with 236 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

145
fhem/FHEM/00_HMLAN.pm
View File

@ -2,6 +2,7 @@
# $Id$ # $Id$
package main; package main;
use strict; use strict;
use warnings; use warnings;
use Time::HiRes qw(gettimeofday time); use Time::HiRes qw(gettimeofday time);
@ -16,10 +17,15 @@ sub HMLAN_secSince2000();
sub HMLAN_SimpleWrite(@); sub HMLAN_SimpleWrite(@);
my $debug = 1; # set 1 for better log readability my $debug = 1; # set 1 for better log readability
my %sets = ( my %sets = ( "hmPairForSec" => "HomeMatic"
"hmPairForSec" => "HomeMatic", ,"hmPairSerial" => "HomeMatic"
"hmPairSerial" => "HomeMatic",
); );
my %HMcond = ( 0 =>'ok'
,2 =>'Warning-HighLoad'
,4 =>'ERROR-Overload'
,254=>'Overload-released'
,255=>'init');
my $HMOvLdRcvr = 6*60;# time HMLAN needs to recover from overload
sub HMLAN_Initialize($) { sub HMLAN_Initialize($) {
my ($hash) = @_; my ($hash) = @_;
@ -31,6 +37,7 @@ sub HMLAN_Initialize($) {
$hash->{WriteFn} = "HMLAN_Write"; $hash->{WriteFn} = "HMLAN_Write";
$hash->{ReadyFn} = "HMLAN_Ready"; $hash->{ReadyFn} = "HMLAN_Ready";
$hash->{SetFn} = "HMLAN_Set"; $hash->{SetFn} = "HMLAN_Set";
$hash->{AttrFn} = "HMLAN_Attr";
$hash->{Clients} = ":CUL_HM:"; $hash->{Clients} = ":CUL_HM:";
my %mc = ( my %mc = (
"1:CUL_HM" => "^A......................", "1:CUL_HM" => "^A......................",
@ -43,8 +50,10 @@ sub HMLAN_Initialize($) {
$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 " . $hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 " .
"loglevel:0,1,2,3,4,5,6 addvaltrigger " . "loglevel:0,1,2,3,4,5,6 addvaltrigger " .
"hmId hmKey " . "hmId hmKey " .
"respTime " . "respTime wdStrokeTime:5,10,15,20,25 " .
"hmProtocolEvents:0_off,1_dump,2_dumpFull,3_dumpTrigger"; "hmProtocolEvents:0_off,1_dump,2_dumpFull,3_dumpTrigger ".
"hmOvTo ".#General remove
$readingFnAttributes;
} }
sub HMLAN_Define($$) {######################################################### sub HMLAN_Define($$) {#########################################################
my ($hash, $def) = @_; my ($hash, $def) = @_;
@ -66,6 +75,7 @@ sub HMLAN_Define($$) {#########################################################
$attr{$name}{dummy} = 1; $attr{$name}{dummy} = 1;
return undef; return undef;
} }
$attr{$name}{wdTimer} = 25;
$hash->{DeviceName} = $dev; $hash->{DeviceName} = $dev;
my $ret = DevIo_OpenDev($hash, 0, "HMLAN_DoInit"); my $ret = DevIo_OpenDev($hash, 0, "HMLAN_DoInit");
return $ret; return $ret;
@ -93,6 +103,15 @@ sub HMLAN_RemoveHMPair($) {####################################################
my $hash = $defs{$name}; my $hash = $defs{$name};
delete($hash->{hmPair}); delete($hash->{hmPair});
} }
sub HMLAN_Attr(@) {#################################
my ($cmd,$name, $attrName,$aVal) = @_;
if ($attrName eq "wdTimer"){#allow between 5 and 25 second
return "select wdTimer between 5 and 25 seconds" if ($aVal>25 || $aVal<5);
$attr{$name}{wdTimer} = $aVal;
}
return;
}
sub HMLAN_Set($@) {############################################################ sub HMLAN_Set($@) {############################################################
my ($hash, @a) = @_; my ($hash, @a) = @_;
@ -194,8 +213,9 @@ sub HMLAN_Write($$$) {#########################################################
if (!$lhash{$dst} && $dst ne "000000"){ if (!$lhash{$dst} && $dst ne "000000"){
HMLAN_SimpleWrite($hash, $IDadd); HMLAN_SimpleWrite($hash, $IDadd);
delete $hash->{helper}{$dst}; delete $hash->{helper}{$dst};
my $rxt = CUL_HM_Get(CUL_HM_id2Hash($dst),CUL_HM_id2Name($dst),"param","rxType"); my $dN = CUL_HM_id2Name($dst);
if (!($rxt & ~0x04)){#config only if (!($dN eq $dst) && # name not found
!(CUL_HM_Get(CUL_HM_id2Hash($dst),$dN,"param","rxType") & ~0x04)){#config only
$hash->{helper}{$dst}{newChn} = '+'.$dst.",01,01,FE1F"; $hash->{helper}{$dst}{newChn} = '+'.$dst.",01,01,FE1F";
} }
else{ else{
@ -271,12 +291,8 @@ sub HMLAN_Parse($$) {##########################################################
if ($letter =~ m/^[ER]/){#@mFld=($src, $status, $msec, $d2, $rssi, $msg) if ($letter =~ m/^[ER]/){#@mFld=($src, $status, $msec, $d2, $rssi, $msg)
# max speed for devices is 100ms after receive - example:TC # max speed for devices is 100ms after receive - example:TC
my $stat = hex($mFld[1]); my ($mNo,$flg,$type,$src,$dst,$p) = unpack('A2A2A2A6A6A*',$mFld[5]);
my ($mNo,$flg,$type,$src,$dst) = ($1,$2,$3,$4,$5)# Std Header my $CULinfo = "";
if ($mFld[5] =~ m/^(..)(..)(..)(.{6})(.{6})/);
my $p = substr($mFld[5],18); # additional content
my $rssi = hex($mFld[4])-65536;
Log $ll5, "HMLAN_Parse: $name R:".$mFld[0] Log $ll5, "HMLAN_Parse: $name R:".$mFld[0]
.(($mFld[0] =~ m/^E/)?' ':'') .(($mFld[0] =~ m/^E/)?' ':'')
.' stat:' .$mFld[1] .' stat:' .$mFld[1]
@ -290,38 +306,40 @@ sub HMLAN_Parse($$) {##########################################################
.' '.$p; .' '.$p;
# handle status. # handle status.
#HMcond stat
# 00 00= msg without relation # 00 00= msg without relation
# 00 01= ack that HMLAN waited for # 00 01= ack that HMLAN waited for
# 00 02= msg send, no ack was requested # 00 02= msg send, no ack requested
# 00 08= nack - ack was requested, msg repeated 3 times, still no ack # 00 08= nack - ack was requested, msg repeated 3 times, still no ack
# 00 21= (seen with 'R') # 00 21= ??(seen with 'R')
# 00 30= # 00 30= ??
# 00 41= (seen with 'R') # 00 41= ??(seen with 'R')
# 00 50= (seen with 'R') # 00 50= ??(seen with 'R')
# 00 81= open # 00 81= ??
# 01 xx= (seen with 'E') # 01 xx= ?? (seen with 'E')
# 02 xx= prestate to 04xx. # 02 xx= prestate to 04xx. Message is still sent. This is a warning
# 04 xx= nothing sent anymore. Any restart unsuccessful except power # 04 xx= nothing sent anymore. Any restart unsuccessful except power
# #
# HMLAN_SimpleWrite($hash, '+'.$src) if (($letter eq 'R') && $src ne AttrVal($name, "hmId", $mFld[4])); # parameter 'cond'- condition of the IO device
# # Cond text
# if (!($flg & 0x25)){#rule out other messages # 0 ok
# HMLAN_SimpleWrite($hash, '-'.$src); # 2 Warning-HighLoad
# HMLAN_SimpleWrite($hash, '+'.$src); #
# } my $stat = hex($mFld[1]);
if($stat & 0x040A){ # do not parse this message, no valid content my $HMcnd =$stat >>8; #high = HMLAN cond
Log $ll5, "HMLAN_Parse: $name problems detected - please restart HMLAN"if($stat & 0x0400); $stat &= 0xff; # low byte related to message format
Log $ll5, "HMLAN_Parse: $name discard" if($stat & 0x000A);
$hash->{helper}{$dst}{flg} = 0;#NACK is also a response, continue process
return ;# message with no ack is send - do not dispatch
}
if ($mFld[1] !~ m/00(01|02|21|41|50)/ && $letter eq 'R'){
Log $ll5, "HMLAN_Parse: $name discard, NACK state:".$mFld[1];
$hash->{helper}{$dst}{flg} = 0;#NACK is also a response, continue process
return;
}
Log $ll5, "HMLAN_Parse: $name special reply ".$mFld[1] if($stat & 0x0200);
if ($stat){# message with status information
HMLAN_condUpdate($hash,$HMcnd)if ($hash->{helper}{HMcnd} != $HMcnd);
$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 Device" if($stat & 0x08);
return;
}
}
my $rssi = hex($mFld[4])-65536;
#update some User information ------ #update some User information ------
$hash->{uptime} = HMLAN_uptime($mFld[2]); $hash->{uptime} = HMLAN_uptime($mFld[2]);
$hash->{RSSI} = $rssi; $hash->{RSSI} = $rssi;
@ -369,13 +387,12 @@ sub HMLAN_Parse($$) {##########################################################
} }
# prepare dispatch----------- # prepare dispatch-----------
# HM format A<len><msg>:<info>:<RSSI>:<IOname> Info is not used anymore # HM format A<len><msg>:<info>:<RSSI>:<IOname> Info is not used anymore
my $dmsg = sprintf("A%02X%s::", length($mFld[5])/2, uc($mFld[5])) my $dmsg = sprintf("A%02X%s:$CULinfo:$rssi:$name",
.$rssi #RSSI length($mFld[5])/2, uc($mFld[5]));
.":".$name; #add sender Name
my %addvals = (RAWMSG => $rmsg, RSSI => hex($mFld[4])-65536); my %addvals = (RAWMSG => $rmsg, RSSI => hex($mFld[4])-65536);
Dispatch($hash, $dmsg, \%addvals); Dispatch($hash, $dmsg, \%addvals);
} }
elsif($mFld[0] eq 'HHM-LAN-IF'){#@mFld=(undef,$vers,$serno,$d1,$owner,$msec,$d2) elsif($mFld[0] eq 'HHM-LAN-IF'){#HMLAN version info
$hash->{serialNr} = $mFld[2]; $hash->{serialNr} = $mFld[2];
$hash->{firmware} = sprintf("%d.%d", (hex($mFld[1])>>12)&0xf, hex($mFld[1]) & 0xffff); $hash->{firmware} = sprintf("%d.%d", (hex($mFld[1])>>12)&0xf, hex($mFld[1]) & 0xffff);
$hash->{owner} = $mFld[4]; $hash->{owner} = $mFld[4];
@ -416,6 +433,7 @@ sub HMLAN_SimpleWrite(@) {#####################################################
# It is not possible to answer befor 100ms # It is not possible to answer befor 100ms
if ($len>51){ if ($len>51){
return if($hash->{helper}{HMcnd} && $hash->{helper}{HMcnd} == 4);#overload
my $dst = substr($msg,46,6); my $dst = substr($msg,46,6);
if ($hash->{helper}{nextSend}{$dst}){ if ($hash->{helper}{nextSend}{$dst}){
my $DevDelay = $hash->{helper}{nextSend}{$dst} - gettimeofday(); my $DevDelay = $hash->{helper}{nextSend}{$dst} - gettimeofday();
@ -481,12 +499,16 @@ sub HMLAN_DoInit($) {##########################################################
HMLAN_SimpleWrite($hash, "T$s2000,04,00,00000000"); HMLAN_SimpleWrite($hash, "T$s2000,04,00,00000000");
delete $hash->{helper}{ref}; delete $hash->{helper}{ref};
$hash->{helper}{HMcnd} = 0xff; # init HMLAN xmit cond, will force reading
RemoveInternalTimer( "Overload:".$name);
foreach (keys %lhash){delete ($lhash{$_})};# clear IDs - HMLAN might have a reset foreach (keys %lhash){delete ($lhash{$_})};# clear IDs - HMLAN might have a reset
$hash->{helper}{keepAliveRec} = 1; # ok for first time $hash->{helper}{keepAliveRec} = 1; # ok for first time
$hash->{helper}{keepAliveRpt} = 0; # ok for first time $hash->{helper}{keepAliveRpt} = 0; # ok for first time
RemoveInternalTimer( "keepAliveCk:".$name);# avoid duplicate timer RemoveInternalTimer( "keepAliveCk:".$name);# avoid duplicate timer
RemoveInternalTimer( "keepAlive:".$name);# avoid duplicate timer RemoveInternalTimer( "keepAlive:".$name);# avoid duplicate timer
InternalTimer(gettimeofday()+25, "HMLAN_KeepAlive", "keepAlive:".$name, 0); InternalTimer(gettimeofday()+$attr{$name}{wdTimer}, "HMLAN_KeepAlive", "keepAlive:".$name, 0);
return undef; return undef;
} }
sub HMLAN_KeepAlive($) {####################################################### sub HMLAN_KeepAlive($) {#######################################################
@ -501,7 +523,8 @@ sub HMLAN_KeepAlive($) {#######################################################
RemoveInternalTimer( "keepAlive:".$name);# avoid duplicate timer RemoveInternalTimer( "keepAlive:".$name);# avoid duplicate timer
my $rt = AttrVal($name,"respTime",1); my $rt = AttrVal($name,"respTime",1);
InternalTimer(gettimeofday()+$rt,"HMLAN_KeepAliveCheck","keepAliveCk:".$name,1); InternalTimer(gettimeofday()+$rt,"HMLAN_KeepAliveCheck","keepAliveCk:".$name,1);
InternalTimer(gettimeofday()+25 ,"HMLAN_KeepAlive", "keepAlive:".$name, 1); $attr{$name}{wdTimer} = 25 if (!$attr{$name}{wdTimer});
InternalTimer(gettimeofday()+$attr{$name}{wdTimer} ,"HMLAN_KeepAlive", "keepAlive:".$name, 1);
} }
sub HMLAN_KeepAliveCheck($) {################################################## sub HMLAN_KeepAliveCheck($) {##################################################
my($in ) = shift; my($in ) = shift;
@ -532,6 +555,28 @@ sub HMLAN_secSince2000() {#####################################################
- 7200; # HM Special - 7200; # HM Special
return $t; return $t;
} }
sub HMLAN_relOvrLd($) {########################################################
my(undef,$name) = split(':',$_[0]);
HMLAN_condUpdate($defs{$name},0xFE);
}
sub HMLAN_condUpdate($$) {#####################################################
my($hash,$HMcnd) = @_;
my $name = $hash->{NAME};
$hash->{helper}{cnd}{$HMcnd} = 0 if (!$hash->{helper}{cnd}{$HMcnd});
$hash->{helper}{cnd}{$HMcnd}++;
if ($HMcnd == 4){
InternalTimer(gettimeofday()+AttrVal($name,"hmOvTo",$HMOvLdRcvr),#General remove Attr, testing only
"HMLAN_relOvrLd","Overload:".$name,1);
}
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;
}
1; 1;
@ -566,6 +611,10 @@ sub HMLAN_secSince2000() {#####################################################
<a name="HMLANdefine"></a> <a name="HMLANdefine"></a>
<b>Define</b> <b>Define</b>
<ul> <ul>
@ -606,6 +655,12 @@ sub HMLAN_secSince2000() {#####################################################
Define max response time of the HMLAN adapter in seconds. Default is 1 sec. 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. Longer times may be used as workaround in slow/instable systems or LAN configurations.
</li> </li>
<li><a href="#wdTimer">wdTimer</a><br>
Time in sec to trigger HMLAN. Values between 5 and 25 are allowed, 25 is default.
It is <B>not recommended</B> to change this timer. If problems are detected with
HLMLAN disconnection it is advisable to resolve the root-cause of the problem and
not sympthoms.
</li>
</ul> </ul>
</ul> </ul>

243
fhem/FHEM/10_CUL_HM.pm
View File

@ -410,8 +410,11 @@ sub CUL_HM_Parse($$) {##############################
$msg =~ m/A(..)(..)(..)(..)(......)(......)(.*)/; $msg =~ m/A(..)(..)(..)(..)(......)(......)(.*)/;
my ($len,$mNo,$mFlg,$mTp,$src,$dst,$p) = ($1,$2,$3,$4,$5,$6,$7); my ($len,$mNo,$mFlg,$mTp,$src,$dst,$p) = ($1,$2,$3,$4,$5,$6,$7);
$p = "" if(!defined($p)); $p = "" if(!defined($p));
my @mI = unpack '(A2)*',$p; # split message info to bytes
return "" if($msgStat && $msgStat eq 'NACK');#discard if lowlevel error if ($msgStat){
return "" if($msgStat eq 'NACK');#discard if lowlevel error
}
return "" if($src eq $id);#discard mirrored messages return "" if($src eq $id);#discard mirrored messages
# $shash will be replaced for multichannel commands # $shash will be replaced for multichannel commands
@ -934,8 +937,8 @@ sub CUL_HM_Parse($$) {##############################
} }
} }
elsif($st eq "outputUnit"){ ################################################# elsif($st eq "outputUnit"){ #################################################
if($mTp eq "40" && $p =~ m/^(..)(..)$/){ if($mTp eq "40" && @mI == 2){
my ($button, $bno) = (hex($1), hex($2)); my ($button, $bno) = (hex($mI[1]), hex($mI[2]));
if(!(exists($shash->{BNO})) || $shash->{BNO} ne $bno){ if(!(exists($shash->{BNO})) || $shash->{BNO} ne $bno){
$shash->{BNO}=$bno; $shash->{BNO}=$bno;
$shash->{BNOCNT}=1; $shash->{BNOCNT}=1;
@ -946,9 +949,9 @@ sub CUL_HM_Parse($$) {##############################
my $btn = int($button&0x3f); my $btn = int($button&0x3f);
push @event, "state:Btn$btn on$target"; push @event, "state:Btn$btn on$target";
} }
elsif(($mTp eq "02" && $p =~ m/^01/) || # handle Ack_Status elsif(($mTp eq "02" && $mI[0] eq "01") || # handle Ack_Status
($mTp eq "10" && $p =~ m/^06/)){ # or Info_Status message ($mTp eq "10" && $mI[0] eq "06")){ # or Info_Status message
my ($msgChn,$msgState) = ((hex($1)&0x1f),$2) if ($p =~ m/..(..)(..)/); my ($msgChn,$msgState) = ((hex($mI[1])&0x1f),$mI[2]) if (@mI > 2);
my $chnHash = $modules{CUL_HM}{defptr}{$src.sprintf("%02X",$msgChn)}; my $chnHash = $modules{CUL_HM}{defptr}{$src.sprintf("%02X",$msgChn)};
if ($model eq "HM-OU-LED16") { if ($model eq "HM-OU-LED16") {
#special: all LEDs map to device state #special: all LEDs map to device state
@ -959,25 +962,44 @@ sub CUL_HM_Parse($$) {##############################
# no event necessary, all the same as before # no event necessary, all the same as before
} }
else {# just update datafields in storage else {# just update datafields in storage
my $bitLoc = ($msgChn-1)*2;#calculate bit location if (@mI > 8){#status for all channel included
my $mask = 3<<$bitLoc; # open to decode byte $mI[4] - related to backlight? seen 20 and 21
my $value = sprintf("%08X",(hex($devState) &~$mask)|($msgState<<$bitLoc)); my $lStat = join("",@mI[5..8]); # all LED status in one long
push @entities,CUL_HM_UpdtReadBulk($shash,1,"color:".$value, my %colTbl=("00"=>"off","01"=>"red","10"=>"green","11"=>"orange");
"state:".$value); my @leds = reverse(unpack('(A2)*',sprintf("%032b",hex($lStat))));
if ($chnHash){ $_ = $colTbl{$_} foreach (@leds);
$shash = $chnHash; for(my $cCnt = 0;$cCnt<16;$cCnt++){# go for all channels
my %colorTable=("00"=>"off","01"=>"red","02"=>"green","03"=>"orange"); my $cH = $modules{CUL_HM}{defptr}{$src.sprintf("%02X",$cCnt+1)};
my $actColor = $colorTable{$msgState}; next if (!$cH);
$actColor = "unknown" if(!$actColor); if (ReadingsVal($cH->{NAME},"color","") ne $leds[$cCnt]) {
push @event, "color:$actColor"; push @entities,CUL_HM_UpdtReadBulk($cH,1,"color:".$leds[$cCnt],
push @event, "state:$actColor"; "state:".$leds[$cCnt]);
}
}
push @entities,CUL_HM_UpdtReadBulk($shash,1,"color:".$lStat,
"state:".$lStat);
}
else{# branch can be removed if message is always that long
my $bitLoc = ($msgChn-1)*2;#calculate bit location
my $mask = 3<<$bitLoc;
my $value = sprintf("%08X",(hex($devState) &~$mask)|($msgState<<$bitLoc));
push @entities,CUL_HM_UpdtReadBulk($shash,1,"color:".$value,
"state:".$value);
if ($chnHash){
$shash = $chnHash;
my %colorTable=("00"=>"off","01"=>"red","02"=>"green","03"=>"orange");
my $actColor = $colorTable{$msgState};
$actColor = "unknown" if(!$actColor);
push @event, "color:$actColor";
push @event, "state:$actColor";
}
} }
} }
} }
elsif ($model eq "HM-OU-CFM-PL"){ elsif ($model eq "HM-OU-CFM-PL"){
if ($chnHash){ if ($chnHash){
$shash = $chnHash; $shash = $chnHash;
my $val = hex($msgState)/2; my $val = hex($mI[2])/2;
$val = ($val == 100 ? "on" : ($val == 0 ? "off" : "$val %")); $val = ($val == 100 ? "on" : ($val == 0 ? "off" : "$val %"));
push @event, "state:$val"; push @event, "state:$val";
} }
@ -1334,9 +1356,6 @@ sub CUL_HM_parseCommon(@){#####################################################
if ($subType =~ m/^8/){ #NACK if ($subType =~ m/^8/){ #NACK
$success = "no"; $success = "no";
CUL_HM_eventP($shash,"Nack"); CUL_HM_eventP($shash,"Nack");
delete($shash->{cmdStack});
delete($shash->{protCmdPend});
CUL_HM_respPendRm($shash);
$reply = "NACK"; $reply = "NACK";
} }
elsif($subType eq "01"){ #ACKinfo################# elsif($subType eq "01"){ #ACKinfo#################
@ -1550,6 +1569,8 @@ sub CUL_HM_Get($@) {
my $cmd = $a[1]; my $cmd = $a[1];
my $dst = $hash->{DEF}; my $dst = $hash->{DEF};
return "" if (!$dst);
my $isChannel = (length($dst) == 8)?"true":""; my $isChannel = (length($dst) == 8)?"true":"";
my $chn = ($isChannel)?substr($dst,6,2):"01"; my $chn = ($isChannel)?substr($dst,6,2):"01";
$dst = substr($dst,0,6); $dst = substr($dst,0,6);
@ -2704,6 +2725,10 @@ sub CUL_HM_SndCmd($$) {
$hash = CUL_HM_getDeviceHash($hash); $hash = CUL_HM_getDeviceHash($hash);
my $io = $hash->{IODev}; my $io = $hash->{IODev};
return if(!$io); return if(!$io);
if ($io->{helper}{HMcnd} == 4){#io is in overload - dont send messages
CUL_HM_eventP($hash,"IOerr");
return;
}
$cmd =~ m/^(..)(.*)$/; $cmd =~ m/^(..)(.*)$/;
my ($mn, $cmd2) = ($1, $2); my ($mn, $cmd2) = ($1, $2);
@ -2732,76 +2757,85 @@ sub CUL_HM_responseSetup($$) {#store all we need to handle the response
if ($cmd =~ m/As(..)(..)(..)(..)(......)(......)(.*)/); if ($cmd =~ m/As(..)(..)(..)(..)(......)(......)(.*)/);
my ($chn,$subType) = ($1,$2) if($p =~ m/^(..)(..)/); 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 ($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);
#--- remove readings in channel
my $chnhash = $modules{CUL_HM}{defptr}{"$dst$chn"};
$chnhash = $hash if (!$chnhash);
delete $chnhash->{READINGS}{peerList};#empty old list
delete $chnhash->{helper}{peerIDsRaw};
$attr{$chnhash->{NAME}}{peerIDs} = '';
return;
}
elsif($subType eq "04"){ #RegisterRead-------
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);
#--- remove channel entries that will be replaced
my $chnhash = $modules{CUL_HM}{defptr}{"$dst$chn"};
$chnhash = $hash if(!$chnhash);
$peer ="" if($list !~ m/^0[34]$/);
#empty val since reading will be cumulative
my $rlName = ((CUL_HM_getAttrInt($hash->{NAME},"expert") == 2)?"":".")."RegL_".$list.":".$peer;
$chnhash->{READINGS}{$rlName}{VAL}="";
delete ($chnhash->{READINGS}{$rlName}{TIME});
return;
}
# elsif($subType eq "0A"){ #Pair Serial----------
# #--- set messaging items
# $hash->{helper}{respWait}{Pending} = "PairSerial";
# $hash->{helper}{respWait}{PendCmd} = $cmd;
# $hash->{helper}{respWait}{forChn} = substr($p,4,20);
#
# # define timeout - holdup cmdStack until response complete or timeout
# InternalTimer(gettimeofday()+$rTo, "CUL_HM_respPendTout", "respPend:$dst", 0);
# return;
# }
}
elsif($mTp eq '11' && $chn =~ m/^(02|81)$/){#!!! chn is subtype!!!
CUL_HM_qStateUpdatIfEnab($dst);
}
if (($mFlg & 0x20) && ($dst ne '000000')){ 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);
#--- remove readings in channel
my $chnhash = $modules{CUL_HM}{defptr}{"$dst$chn"};
$chnhash = $hash if (!$chnhash);
delete $chnhash->{READINGS}{peerList};#empty old list
delete $chnhash->{helper}{peerIDsRaw};
$attr{$chnhash->{NAME}}{peerIDs} = '';
return;
}
elsif($subType eq "04"){ #RegisterRead-------
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);
#--- remove channel entries that will be replaced
my $chnhash = $modules{CUL_HM}{defptr}{"$dst$chn"};
$chnhash = $hash if(!$chnhash);
$peer ="" if($list !~ m/^0[34]$/);
#empty val since reading will be cumulative
my $rlName = ((CUL_HM_getAttrInt($hash->{NAME},"expert") == 2)?"":".")."RegL_".$list.":".$peer;
$chnhash->{READINGS}{$rlName}{VAL}="";
delete ($chnhash->{READINGS}{$rlName}{TIME});
return;
}
# elsif($subType eq "0A"){ #Pair Serial----------
# #--- set messaging items
# $hash->{helper}{respWait}{Pending} = "PairSerial";
# $hash->{helper}{respWait}{PendCmd} = $cmd;
# $hash->{helper}{respWait}{forChn} = substr($p,4,20);
#
# # define timeout - holdup cmdStack until response complete or timeout
# InternalTimer(gettimeofday()+$rTo, "CUL_HM_respPendTout", "respPend:$dst", 0);
# return;
# }
}
elsif($mTp eq '11' && $chn =~ m/^(02|81)$/){#!!! chn is subtype!!!
CUL_HM_qStateUpdatIfEnab($dst);
}
$hash->{helper}{respWait}{cmd} = $cmd; $hash->{helper}{respWait}{cmd} = $cmd;
$hash->{helper}{respWait}{mNo} = $mNo; #mNo we wait to ack $hash->{helper}{respWait}{mNo} = $mNo; #mNo we wait to ack
$hash->{helper}{respWait}{reSent} = 1; $hash->{helper}{respWait}{reSent} = 1;
InternalTimer(gettimeofday()+rand(40)/10+1, "CUL_HM_Resend", $hash, 0); InternalTimer(gettimeofday()+rand(40)/10+1, "CUL_HM_Resend", $hash, 0);
CUL_HM_protState($hash,"CMDs_processing...");
}
else{# no answer expected
CUL_HM_protState($hash,"CMDs_done".($hash->{helper}{burstEvtCnt}?
("_events:".$hash->{helper}{burstEvtCnt}):""));
}
if($hash->{cmdStack} && scalar @{$hash->{cmdStack}}){
$hash->{protCmdPend} = scalar @{$hash->{cmdStack}}." CMDs pending";
}
else{
delete($hash->{protCmdPend});
} }
} }
sub CUL_HM_eventP($$) {#handle protocol events sub CUL_HM_eventP($$) {#handle protocol events
#todo: add severity, counter, history and acknowledge #todo: add severity, counter, history and acknowledge
my ($hash, $evntType) = @_; my ($hash, $evntType) = @_;
my $name = $hash->{NAME};
my $nAttr = $hash; my $nAttr = $hash;
return if (!$name);
if ($evntType eq "Rcv"){ if ($evntType eq "Rcv"){
$nAttr->{"protLastRcv"} = TimeNow(); $nAttr->{"protLastRcv"} = TimeNow();
return; return;
@ -2812,15 +2846,20 @@ sub CUL_HM_eventP($$) {#handle protocol events
$nAttr->{"prot".$evntType} = ++$evntCnt." last_at:".TimeNow(); $nAttr->{"prot".$evntType} = ++$evntCnt." last_at:".TimeNow();
if ($evntType ne "Snd"){#count unusual events if ($evntType ne "Snd"){#count unusual events
if ($hash->{helper}{burstEvtCnt}){ $hash->{helper}{burstEvtCnt}=0 if(!defined $hash->{helper}{burstEvtCnt});
$hash->{helper}{burstEvtCnt}++; $hash->{helper}{burstEvtCnt}++;
}else {$hash->{helper}{burstEvtCnt}=1;};
} }
if ($evntType eq "Nack" ||$evntType eq "ResndFail"){ if ($evntType =~ m/(Nack|ResndFail|IOerr)/){
$nAttr->{protCmdDel} = 0 if(!$nAttr->{protCmdDel}); if ( (CUL_HM_getRxType($hash) & 0x03) == 0 #to slow for wakeup and config
$nAttr->{protCmdDel} += scalar @{$hash->{cmdStack}} if ($hash->{cmdStack}); || $evntType eq "IOerr"){ #IO problem
CUL_HM_protState($hash,"CMDs_done".($hash->{helper}{burstEvtCnt}? $nAttr->{protCmdDel} = 0 if(!$nAttr->{protCmdDel});
$nAttr->{protCmdDel} += scalar @{$hash->{cmdStack}} if ($hash->{cmdStack});
delete($hash->{cmdStack});
delete($nAttr->{protCmdPend});
CUL_HM_protState($hash,"CMDs_done".($hash->{helper}{burstEvtCnt}?
("_events:".$hash->{helper}{burstEvtCnt}):"")); ("_events:".$hash->{helper}{burstEvtCnt}):""));
}
CUL_HM_respPendRm($hash);
} }
} }
sub CUL_HM_protState($$){ sub CUL_HM_protState($$){
@ -2855,17 +2894,10 @@ sub CUL_HM_respPendTout($) {
Log GetLogLevel($name,4),"CUL_HM_Resend: ".$name. " nr ".$pendRsndCnt; Log GetLogLevel($name,4),"CUL_HM_Resend: ".$name. " nr ".$pendRsndCnt;
$hash->{helper}{respWait}{PendingRsend} = $pendRsndCnt + 1; $hash->{helper}{respWait}{PendingRsend} = $pendRsndCnt + 1;
CUL_HM_SndCmd($hash,substr($hash->{helper}{respWait}{PendCmd},4)); CUL_HM_SndCmd($hash,substr($hash->{helper}{respWait}{PendCmd},4));
CUL_HM_eventP($hash,"Resnd") if ($pendCmd); CUL_HM_eventP($hash,"Resnd");
} }
else{ else{
CUL_HM_eventP($hash,"ResndFail") if ($pendCmd); CUL_HM_eventP($hash,"ResndFail");
if ((CUL_HM_getRxType($hash) & 0x03) == 0){#to slow for wakeup and config
delete($hash->{cmdStack});
delete($hash->{protCmdPend});
CUL_HM_protState($hash,"CMDs_done".($hash->{helper}{burstEvtCnt}?
("_events:".$hash->{helper}{burstEvtCnt}):""));
}
CUL_HM_respPendRm($hash);
CUL_HM_ProcessCmdStack($hash); # continue processing commands CUL_HM_ProcessCmdStack($hash); # continue processing commands
readingsSingleUpdate($hash,"state","RESPONSE TIMEOUT:".$pendCmd,1); readingsSingleUpdate($hash,"state","RESPONSE TIMEOUT:".$pendCmd,1);
} }
@ -2899,8 +2931,6 @@ sub CUL_HM_ProcessCmdStack($) {
!$hash->{helper}{respWait}{Pending}){ !$hash->{helper}{respWait}{Pending}){
if(@{$hash->{cmdStack}}) { if(@{$hash->{cmdStack}}) {
CUL_HM_SndCmd($hash, shift @{$hash->{cmdStack}}); CUL_HM_SndCmd($hash, shift @{$hash->{cmdStack}});
$hash->{protCmdPend} = scalar @{$hash->{cmdStack}}." CMDs pending";
CUL_HM_protState($hash,"CMDs_processing...");
CUL_HM_eventP($hash,"Snd"); CUL_HM_eventP($hash,"Snd");
} }
elsif(!@{$hash->{cmdStack}}) { elsif(!@{$hash->{cmdStack}}) {
@ -2965,12 +2995,8 @@ sub CUL_HM_Resend($) {#resend a message if there is no answer
return if(!$hash->{helper}{respWait}{reSent}); # Double timer? return if(!$hash->{helper}{respWait}{reSent}); # Double timer?
if($hash->{helper}{respWait}{reSent} >= 3) { if($hash->{helper}{respWait}{reSent} >= 3) {
CUL_HM_eventP($hash,"ResndFail"); CUL_HM_eventP($hash,"ResndFail");
delete($hash->{cmdStack});
delete($hash->{protCmdPend});
CUL_HM_respPendRm($hash);
CUL_HM_protState($hash,"CMDs_done".($hash->{helper}{burstEvtCnt}?
("_events:".$hash->{helper}{burstEvtCnt}):""));
readingsSingleUpdate($hash,"state","MISSING ACK",1); readingsSingleUpdate($hash,"state","MISSING ACK",1);
CUL_HM_ProcessCmdStack($hash); # continue processing commands if any
} }
else { else {
CUL_HM_eventP($hash,"Resnd"); CUL_HM_eventP($hash,"Resnd");
@ -4062,9 +4088,12 @@ sub CUL_HM_putHash($) {# provide data for HMinfo
Note4: the direct buttons on a HM device are hidden by default. Note4: the direct buttons on a HM device are hidden by default.
Nevertheless those are implemented as links as well. To get access to Nevertheless those are implemented as links as well. To get access to
the 'internal links' it is necessary to issue 'set &lt;name&gt; regSet the 'internal links' it is necessary to issue <br>
intKeyVisib 1' or 'set &lt;name&gt; setRegRaw List0 2 81'. Reset it 'set &lt;name&gt; <a href="#CUL_HMregSet">regSet</a> intKeyVisib visib'<br>
by replacing '81' with '01'<br> example:<br> or<br>
'set &lt;name&gt; <a href="#CUL_HMregBulk">regBulk</a> RegL_0: 2:81'<br>
Reset it by replacing '81' with '01'<br> example:<br>
<ul><code> <ul><code>
set mydimmer getRegRaw List1<br> set mydimmer getRegRaw List1<br>
@ -4121,8 +4150,6 @@ sub CUL_HM_putHash($) {# provide data for HMinfo
set myChannel peerBulk 12345601 unset # remove peer 123456 channel 01<br> set myChannel peerBulk 12345601 unset # remove peer 123456 channel 01<br>
</code></ul> </code></ul>
</li> </li>
<li><B>regRaw [List0|List1|List2|List3|List4] &lt;addr&gt; &lt;data&gt;</B>
replaced by regBulk</li>
<li><B>regBulk &lt;reg List&gt;:&lt;peer&gt; &lt;addr1:data1&gt; &lt;addr2:data2&gt;... <li><B>regBulk &lt;reg List&gt;:&lt;peer&gt; &lt;addr1:data1&gt; &lt;addr2:data2&gt;...
</B><a name="CUL_HMregBulk"></a><br> </B><a name="CUL_HMregBulk"></a><br>
This command will replace the former regRaw. It allows to set register This command will replace the former regRaw. It allows to set register