diff --git a/fhem/contrib/Wzut/14_CUL_MAX.pm b/fhem/contrib/Wzut/14_CUL_MAX.pm new file mode 100644 index 000000000..b7e75119c --- /dev/null +++ b/fhem/contrib/Wzut/14_CUL_MAX.pm @@ -0,0 +1,1481 @@ +############################################## +# $Id: $ +# +# (c) 2012 Copyright: Matthias Gehre, M.Gehre@gmx.de +# (c) 2019 Copyright: Wzut +# +# All rights reserved +# +# FHEM Forum : http://forum.fhem.de/ +# +# This code is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# The GNU General Public License can be found at +# http://www.gnu.org/copyleft/gpl.html. +# A copy is found in the textfile GPL.txt and important notices to the license +# from the author is found in LICENSE.txt distributed with these scripts. +# This script is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +################################################################ + +package main; + +use strict; +use warnings; + +my %device_types = ( + 0 => "Cube", + 1 => "HeatingThermostat", + 2 => "HeatingThermostatPlus", + 3 => "WallMountedThermostat", + 4 => "ShutterContact", + 5 => "PushButton", + 6 => "virtualShutterContact", + 7 => "virtualThermostat", + 8 => "PlugAdapter", + 9 => "new" +); + +my %msgId2Cmd = ( + "00" => "PairPing", + "01" => "PairPong", + "02" => "Ack", + "03" => "TimeInformation", + + "10" => "ConfigWeekProfile", + "11" => "ConfigTemperatures", #like eco/comfort etc + "12" => "ConfigValve", + + "20" => "AddLinkPartner", + "21" => "RemoveLinkPartner", + "22" => "SetGroupId", + "23" => "RemoveGroupId", + + "30" => "ShutterContactState", + + "40" => "SetTemperature", # to thermostat + "42" => "WallThermostatControl", # by WallMountedThermostat + # Sending this without payload to thermostat sets desiredTempeerature to the comfort/eco temperature + # We don't use it, we just do SetTemperature + "43" => "SetComfortTemperature", + "44" => "SetEcoTemperature", + + "50" => "PushButtonState", + + "60" => "ThermostatState", # by HeatingThermostat + + "70" => "WallThermostatState", + + "82" => "SetDisplayActualTemperature", + + "F1" => "WakeUp", + "F0" => "Reset", + ); + +my %msgCmd2Id = reverse %msgId2Cmd; + +my $defaultWeekProfile = "444855084520452045204520452045204520452045204520452044485508452045204520452045204520452045204520452045204448546c44cc55144520452045204520452045204520452045204448546c44cc55144520452045204520452045204520452045204448546c44cc55144520452045204520452045204520452045204448546c44cc55144520452045204520452045204520452045204448546c44cc5514452045204520452045204520452045204520"; + + +my $ackTimeout = 3; # seconds +my $maxRetryCnt = 3; +my $sq->{sendQueue} = [] ; + $sq->{usedFrom} = "" ; + +sub CUL_MAX_Initialize +{ + my $hash = shift; + + $hash->{Match} = "^Z"; + $hash->{DefFn} = "CUL_MAX_Define"; + $hash->{Clients} = ":MAX:"; + $hash->{MatchList} = {"1:MAX" => "MAX"}; + $hash->{UndefFn} = "CUL_MAX_Undef"; + $hash->{ParseFn} = "CUL_MAX_Parse"; + $hash->{RenameFn} = "CUL_MAX_RenameFn"; + $hash->{SetFn} = "CUL_MAX_Set"; + $hash->{GetFn} = "CUL_MAX_Get"; + $hash->{AttrFn} = "CUL_MAX_Attr"; + $hash->{AttrList} = "IODev IOgrp do_not_notify:1,0 ignore:0,1 debug:0,1 showtime:1,0 fakeSCaddr fakeWTaddr broadcastTimeDiff blacklist whitelist ".$readingFnAttributes; + + return; +} + +sub CUL_MAX_updateConfig +{ + # this routine is called 5 sec after the last define of a restart + # this gives FHEM sufficient time to fill in attributes + + my $hash = shift; + my $name = $hash->{NAME}; + + if (!$init_done) + { + RemoveInternalTimer($hash); + InternalTimer(gettimeofday()+5,"CUL_MAX_updateConfig", $hash, 0); + return; + } + + $attr{$name}{fakeSCaddr} = '222222' unless (exists($attr{$name}{fakeSCaddr})); + $attr{$name}{fakeWTaddr} = '111111' unless (exists($attr{$name}{fakeWTaddr})); + + my $iogrp = AttrVal($name , 'IOgrp' ,''); + my @ios; + my $version; + + if ($iogrp) + { + $iogrp =~ s/ //g; + @ios = split(',',$iogrp); + $hash->{IOgrp} = ''; + Log3 $hash,1,$name.', attribute IOgrp has only a single CUL device, please delete attribute IOgrp !' if (int(@ios) < 2); + $hash->{'.culids'} = ''; + + foreach (@ios) + { + AssignIoPort($hash, $_); # mit proposed $_ + if (defined($hash->{IODev})) + { + $version = CUL_MAX_Check($hash); + $hash->{$_.'_VERSION'} = $version; + $hash->{'.VERSION'} = $version; + + if ($version < 152) + { + Log3 $hash, 1, $name.', detected very old firmware version '.$version.' of the CUL-compatible IODev '.$_; + } + if ($version >= 152) + { + #Doing this on older firmware disables MAX mode + #Append to initString, so this is resend if cul disappears and then reappears + if (!defined($hash->{IODev}{'.maxid'})) + { + IOWrite($hash, "", "Za". $hash->{addr}); + $hash->{IODev}{initString} .= "\nZa". $hash->{addr}; + } + else + { + IOWrite($hash, "", "Za". $hash->{IODev}{'.maxid'}); + $hash->{IODev}{initString} .= "\nZa".$hash->{IODev}{'.maxid'}; + } + } + if ($version >= 153) + { + #Doing this on older firmware disables MAX mode + my $cmd = "Zw". AttrVal($name,'fakeWTaddr','111111'); + IOWrite($hash, "", $cmd); + $hash->{IODev}{initString} .= "\n".$cmd; + } + $hash->{IOgrp} .= ($hash->{IOgrp}) ?','.$_ : $_ ; + }# iodev + } #foreach + + if (!defined($hash->{IODev})) + { + Log3 $hash, 1, "$name, did not find suitable IODev (CUL etc. in rfmode MAX)! You may want to execute 'attr $hash->{NAME} IODev SomeCUL'"; + return; + } + } # iogrp + else + { # no IOgrp , use IOdev + AssignIoPort($hash, AttrVal($name,'IODev','')) if (defined(AttrVal($name,'IODev',undef))); # ohne Attr IODev geht nichts ! + if (defined($hash->{IODev})) + { + $version = CUL_MAX_Check($hash); + $hash->{'.VERSION'} = $version; + if ($version < 152) + { + Log3 $hash, 1, "$name, detected very old firmware version $version of the CUL-compatible IODev ".AttrVal($name,'IODev',''); + } + + if ($version >= 152) + { + #Doing this on older firmware disables MAX mode + IOWrite($hash, "", "Za". $hash->{addr}); + #Append to initString, so this is resend if cul disappears and then reappears + $hash->{IODev}{initString} .= "\nZa". $hash->{addr}; + } + if ($version >= 153) + { + #Doing this on older firmware disables MAX mode + my $cmd = "Zw". AttrVal($name,'fakeWTaddr','111111'); + IOWrite($hash, "", $cmd); + $hash->{IODev}{initString} .= "\n".$cmd; + } + } + else + { + Log3 $hash, 1, "$name, did not find suitable IODev (CUL etc. in rfmode MAX)! You may want to execute 'attr $hash->{NAME} IODev SomeCUL'"; + return; + } + }# use IOdev + + #This interface is shared with 00_MAXLAN.pm + $hash->{Send} = \&CUL_MAX_Send; + + #Start broadcasting time after 30 seconds, so there is enough time to parse the config + InternalTimer(gettimeofday()+30, "CUL_MAX_BroadcastTime", $hash, 0); + InternalTimer(gettimeofday() + 300, "CUL_MAX_Alive", $hash, 0); + return; + +} + +sub CUL_MAX_Define +{ + my $hash = shift; + my $def = shift; + my $name = $hash->{NAME}; + my $ret; + + my @ar = split("[ \t][ \t]*", $def); + return "wrong syntax: define $name CUL_MAX " if (@ar < 3); + + my $MAXid = lc($ar[2]); + + if ((length($ar[2]) != 6) || ($MAXid !~ m/^[a-f0-9]{6}$/i)) + { + $ret = "$name, the address must be 6 hexadecimal digits"; + Log3 $hash, 1, $ret; + return $ret; + } + + if (exists($modules{CUL_MAX}{defptr}) && ($modules{CUL_MAX}{defptr}{$MAXid}->{NAME} ne $name)) + { + $ret = "a CUL_MAX device with address $MAXid is already defined !"; + Log3 $name, 1, $ret; + return $ret; + } + + $modules{CUL_MAX}{defptr} = $hash; + + $hash->{addr} = $MAXid; + $hash->{STATE} = "Defined"; + $hash->{cnt} = 0; + $hash->{pairmode} = 0; + $hash->{retryCount} = 0; + $hash->{sendQueue} = []; + $hash->{sq} = 0; + $hash->{LASTInputDev} = ''; + $hash->{'.culids'} = ''; + + RemoveInternalTimer($hash); + InternalTimer(gettimeofday()+5, 'CUL_MAX_updateConfig', $hash, 0); + + return; +} + +##################################### +sub CUL_MAX_Undef +{ + my $hash = shift; + RemoveInternalTimer($hash); + delete $modules{CUL_MAX}{defptr}; + return; +} + +sub CUL_MAX_DisablePairmode +{ + my $hash = shift; + $hash->{pairmode} = 0; + return; +} + +sub CUL_MAX_Check +{ + my $hash = shift; + my $nocheck = shift; + $nocheck //= 0; + my $name = $hash->{NAME}; + + if (!defined($hash->{IODev})) + { + Log3 $hash, 1, "$name, no IODev found"; + return 0; + } + + if (!defined($hash->{IODev}{VERSION})) + { + Log3 $hash, 1, "$name, IODev has no VERSION"; + return 0; + } + + my $cul = $hash->{IODev}{NAME}; + my $maxid = lc(AttrVal($cul,'maxid','')); + + if ($maxid && $maxid !~ m/^[a-f0-9]{6}$/i) + { + $maxid = ''; + Log3 $hash,1,"$name, wrong value for attribute maxid on $cul - ignoring !"; + } + + if (!$maxid) + { + Log3 $hash,1,"$name please set attribute maxid on $cul !" if (AttrVal($name,'IOgrp','')); + } + else + { + $hash->{$cul.'_MAXID'} = $maxid; + $hash->{'.culids'} .= $maxid.' ' if (index($hash->{'.culids'},$maxid) == -1); + $hash->{IODev}{'.maxid'} = $maxid; + $hash->{addr} = $maxid; + } + + my $version = $hash->{IODev}{VERSION}; + + if ($version =~ m/.*a-culfw.*/) + { + #a-culfw is compatibel to culfw 154 + return 154; + } + + #Looks like "V 1.49 CUL868" + if ($version =~ m/V (.*)\.(.*) .*/) + { + my ($major_version,$minorversion) = ($1, $2); + $version = 100*$major_version + $minorversion; + if ($version < 154) + { + Log3 $hash, 2, "$name, You are using an old version of the CUL firmware, which has known bugs with respect to MAX! support. Please update."; + } + return $version; + } + else + { + Log3 $hash, 1, "$name, could not correctly parse IODev->{VERSION} = '$version'"; + } + + return 0; +} + +sub CUL_MAX_Attr +{ + my ($cmd, $name, $attrName, $attrVal) = @_; + return if ($cmd ne 'set'); + + if ((($attrName eq 'fakeWTaddr') + || ($attrName eq 'fakeSCaddr')) + && ($attrVal !~ /^[0-9a-fA-F]{6}$/)) { return "$name, invalid value $attrVal for attr $attrName"; } + + return; +} + + +sub CUL_MAX_Get +{ + my ($hash, $name, $cmd, @args) = @_; + return "$name, get needs at least one parameter" if (!$cmd); + + if ($cmd eq 'deviceinfo') + { + return 'missing address' if (!defined($args[0])); + return 'no MAX device' if (!exists($modules{MAX}{defptr}{$args[0]})); + my $list = eval { require Data::Dumper; return Dumper($modules{MAX}{defptr}{$args[0]}); } ; + return $list; + } + elsif ($cmd eq 'showSendQueue') + { + return 'Send Queue is empty !' if (!$hash->{sq}); + + my ($i,$dst,$cmd,$time,$cul,$s,@lines); + my $dw = 11; + my $cw = 7; + my $lw = 3; + + for ($i = 0; $i < @{$hash->{sendQueue}}; $i++) + { + $dst = $hash->{sendQueue}[$i]->{dst_name}; + $cmd = $hash->{sendQueue}[$i]->{cmd}; + $time = FmtDateTime($hash->{sendQueue}[$i]->{time}); + $cul = (defined($hash->{sendQueue}[$i]->{CUL})) ? $hash->{sendQueue}[$i]->{CUL} : '-'; + + $dw = length($dst) if (length($dst) > $dw); + $cw = length($cmd) if (length($cmd) > $cw); + $lw = length($cul) if (length($cul) > $lw); + + push @lines, "$time,$dst,$cmd,$cul"; + } + + $s = ' Time | Destination'.(' 'x($dw-11)).' | Command'.(' 'x($cw-7)); + $s.= (AttrVal($name,'IOgrp','')) ? ' | CUL'.(' 'x($lw-3)) : ''; + + my $line = ('-' x length($s)); + while ( $s =~ m/\|/g ) { substr($line,(pos($s)-1),1) = '+'; } + + $s .= "\n".$line."\n"; + + foreach (@lines) + { + my @a = split(',',$_); + $a[1] .= (' 'x($dw-length($a[1]))) if ($dw-length($a[1])); + $a[2] .= (' 'x($cw-length($a[2]))) if ($cw-length($a[2])); + $s.= "$a[0] | $a[1] | $a[2]"; + $s.= (AttrVal($name,'IOgrp','')) ? " | $a[3]\n" : "\n"; + } + return $s.$line; + } + else + { + return 'unknown command '.$cmd.', choose one of deviceinfo showSendQueue:noArg'; + } + + return; +} + + +sub CUL_MAX_Set +{ + + my ( $hash, $name, $cmd, @args ) = @_; + return "set $name needs at least one parameter" if (!$cmd || !defined($cmd)); + + if ($cmd eq 'deleteSendQueue') + { + $hash->{sendQueue} = []; + $hash->{sq} = 0; + return; + } + + if ($cmd eq 'pairmode') + { + $hash->{pairmode} = 1; + my $pairmodeDuration = (int($args[0]) > 60) ? int($args[0]) : 60; + InternalTimer(gettimeofday()+$pairmodeDuration, 'CUL_MAX_DisablePairmode', $hash, 0); + return; + } + + if ($cmd eq 'broadcastTime') + { + CUL_MAX_BroadcastTime($hash, 1); + return; + } + + if (($cmd eq 'fakeSC') || ($cmd eq 'fakeWT')) + { + return "$name invalid number of arguments for $cmd" if (!@args); + my $dest = $args[0]; + my $destname; + #$dest may be either a name or an address + if (exists($defs{$dest})) + { + return 'Destination is not a MAX device' if ($defs{$dest}{TYPE} ne 'MAX'); + $destname = $dest; + $dest = $defs{$dest}{addr}; + } + else + { + $dest = lc($dest); #address to lower-case + return 'No MAX device with address '.$dest.' found !' if (!exists($modules{MAX}{defptr}{$dest})); + $destname = $modules{MAX}{defptr}{$dest}{NAME}; + } + + if ($cmd eq 'fakeSC') + { + return $name.', invalid number of arguments for '.$cmd if (@args != 2); + return $name.', invalid fakeSCaddr attribute set (must not be 000000)' if (AttrVal($name,'fakeSCaddr','') eq '000000'); + + my $state = $args[1] ? '12' : '10'; + my $groupid = ReadingsVal($destname,'groupid',0); + return CUL_MAX_Send($hash, 'ShutterContactState',$dest,$state,groupId => sprintf("%02x",$groupid), + flags => ( $groupid ? '04' : '06' ),src => AttrVal($name,'fakeSCaddr','222222')); + + } + elsif ($cmd eq 'fakeWT') + { + return $name.', invalid number of arguments for '.$cmd if (@args != 3); + return $name.', desiredTemperature is invalid' if (!validTemperature($args[1])); + return $name.',invalid fakeWTaddr attribute set (must not be 000000)' if (AttrVal($name,'fakeWTaddr','') eq '000000'); + + #Valid range for measured temperature is 0 - 51.1 degree + $args[2] = 0 if ($args[2] < 0); #Clamp temperature to minimum of 0 degree + + #Encode into binary form + my $arg2 = int(10*$args[2]); + #First bit is 9th bit of temperature, rest is desiredTemperature + my $arg1 = (($arg2&0x100)>>1) | (int(2*MAX_ParseTemperature($args[1]))&0x7F); + $arg2 &= 0xFF; #only take the lower 8 bits + my $groupid = ReadingsNum($destname,'groupid',0); + + return CUL_MAX_Send($hash,'WallThermostatControl',$dest,sprintf("%02x%02x",$arg1,$arg2), groupId => sprintf("%02x",$groupid), + flags => ( $groupid ? '04' : '00' ), src => AttrVal($name,'fakeWTaddr','111111')); + } + } + else + { + return "unknown argument $cmd, choose one of pairmode:60,300,600 broadcastTime:noArg deleteSendQueue:noArg fakeSC fakeWT"; + } + return; +} + +sub CUL_MAX_Parse +{ + # Attention: there is a limit in the culfw firmware: It only receives messages shorter than 30 bytes (see rf_moritz.h) + # $hash is for the CUL instance + my ($hash, $rmsg) = @_; + my $shash = undef; #shash is for the CUL_MAX instance + + return $hash->{NAME} if (!$init_done); # brauchen wir das noch wenn alle Prototypen weg sind ? + + # Find a CUL_MAX that has the CUL $hash as its IODev; + # if no matching is found, just use the last encountered CUL_MAX. + # change -> Implementierung des Highlander-Prinzips: Es kann nur Einen geben! D.h. Schaffung eindeutiger Zuständigkeiten + + foreach my $d (keys %defs) + { + if ($defs{$d}{TYPE} eq "CUL_MAX") + { + $shash = $defs{$d}; + last if ($defs{$d}{IODev} == $hash); + } + } + + if (!defined($shash)) + { + Log3 $hash, 2, 'CM_Parse, no matching CUL_MAX device found'; + return $hash->{NAME}; # if (!$ac); + } + + my $name = $shash->{NAME}; + + if (length($rmsg) < 21) + { + Log3 $hash,5,"$name, message $rmsg is to short !"; + return $shash->{NAME}; + } + + my $l = substr($rmsg,1,2); + $l = hex($l); + if (2*$l+3 != length($rmsg)) + { #+3 = +1 for 'Z' and +2 for len field in hex + Log3 $shash, 1, $name.', message $rmsg len mismatch '.length($rmsg).' vs '.(2*$l+3); + return $shash->{NAME}; + } + + if ($rmsg !~ m/Z(..)(..)(..)(..)(......)(......)(..)(.*)/) + { + Log3 $shash,3, "$name, unknown message : $rmsg"; + return $shash->{NAME}; + } + + my ($len,$msgcnt,$msgFlag,$msgTypeRaw,$src,$dst,$groupid,$payload) = ($1,$2,$3,$4,$5,$6,$7,$8); + $groupid = hex($groupid); + + $len = hex($len); + if (2*$len+3 != length($rmsg)) + { + #+3 = +1 for 'Z' and +2 for len field in hex + Log3 $shash, 1, $name.', message len mismatch '.length($rmsg).' vs '.(2*$len+3); + return $shash->{NAME}; + } + + #convert adresses to lower case + $src = lc($src); + $dst = lc($dst); + + if (exists($modules{MAX}{defptr}{$src}) && !exists($modules{MAX}{defptr}{$src}->{NAME})) + { + Log3 $shash ,3, $name.', source device '.$src.' has no name !' if (($src ne $shash->{addr}) && ($src ne '000000')); + } + + if (exists($modules{MAX}{defptr}{$dst}) && !exists($modules{MAX}{defptr}{$dst}->{NAME})) + { + Log3 $shash ,3, $name.', target device '.$dst.' has no name !' if (($dst ne $shash->{addr}) && ($dst ne '000000')); + } + + my $debug = AttrNum($name,'debug',0); + my @whitelist = split(',', lc(AttrVal($name,'whitelist',''))); + my @blacklist = split(',', lc(AttrVal($name,'blacklist',''))); + + my $nogo = 0; + + if (@whitelist) + { + Log3 $shash,2, "$name, whitelist and blacklist found. Blacklist ignoring !" if (@blacklist); + foreach (@whitelist) + { + $_ =~ s/ //g; + $nogo = 1 if (($_ eq $src) || ($_ eq $dst)); + } + if (!$nogo) + { + Log3 $shash,4, "$name, soure $src or destination $dst not found on whitelist - ignoring !"; + return $shash->{NAME}; + } + } + elsif (@blacklist) + { + foreach (@blacklist) + { + $_ =~ s/ //g; + $nogo = 1 if (($_ eq $src) || ($_ eq $dst)); + } + if ($nogo) + { + Log3 $shash,4, "$name, soure $src or destination $dst found on blacklist - ignoring !"; + return $shash->{NAME}; + } + } + + my $src_name = (exists($modules{MAX}{defptr}{$src}) && exists($modules{MAX}{defptr}{$src}->{NAME})) ? $modules{MAX}{defptr}{$src}->{NAME} : 'MAX_'.$src; + + return $shash->{NAME} if (exists($modules{MAX}{defptr}{$src}) && IsIgnored($src_name)); + + my $dst_name = (exists($modules{MAX}{defptr}{$dst}) && exists($modules{MAX}{defptr}{$dst}->{NAME})) ? $modules{MAX}{defptr}{$dst}->{NAME} : 'MAX_'.$dst; + $dst_name = 'Broadcast' if ($dst_name eq 'MAX_000000'); + + my $msgType = exists($msgId2Cmd{$msgTypeRaw}) ? $msgId2Cmd{$msgTypeRaw} : $msgTypeRaw; + my $rssi = exists($hash->{RSSI}) ? $hash->{RSSI} : 0; + + Log3 $shash, 5, "$name, IODev $hash->{NAME}, len $len, msgcnt $msgcnt, msgflag $msgFlag, msgType $msgType, src $src, dst $dst, group $groupid, payload $payload, rssi $rssi"; + + my $isToMe; + my $isMe; + + if (!$shash->{'.culids'}) # keine verschieden IDs ! + { + $isToMe = ($dst eq $shash->{addr}) ? 1 : 0; # $isToMe is true if that packet was directed at us + $dst_name = 'ToMe' if ($isToMe); + $isMe = ($src eq $shash->{addr}) ? 1 : 0; + } + else + { + $isToMe = (index($shash->{'.culids'},$dst) != -1) ? 1 : 0; + $isMe = (index($shash->{'.culids'},$src) != -1) ? 1 : 0; + $dst_name = 'ToMe' if ($isToMe); + } + + if ($isMe) # is true if we received a packet from our second CUL + { + Log3 $shash, 4, $name.', packet from ourselves or a other CUL ['.$src.' / '.$isToMe.'], - ignoring !'; + return $shash->{NAME}; + } + + my $dummy = AttrNum($src_name,'dummy',0); + $isToMe = 0 if ($dummy); + + # Set RSSI , msgcount and destination on MAX device + if (exists($modules{MAX}{defptr}{$src})) + { + $modules{MAX}{defptr}{$src}{'.rssi'} = (exists($hash->{RSSI})) ? $hash->{RSSI} : 0 ; + $modules{MAX}{defptr}{$src}{'.count'} = hex($msgcnt) if (abs($modules{MAX}{defptr}{$src}{'.count'}) != hex($msgcnt)); + $modules{MAX}{defptr}{$src}{'.sendToName'} = ($dst_name ne 'ToMe') ? $dst_name : ''; + $modules{MAX}{defptr}{$src}{'.sendToAddr'} = ($dst_name ne 'ToMe') ? $dst : '-1'; + } + + if (exists($msgId2Cmd{$msgTypeRaw})) + { + if ($msgType eq "Ack") + { + #Ignore packets generated by culfw's auto-Ack + #if (($src eq $shash->{addr}) || ($src eq CUL_MAX_fakeWTaddr($shash)) || ($src eq CUL_MAX_fakeSCaddr($shash))) + if ($isMe || ($src eq AttrVal($name,'fakeWTaddr','111111')) || ($src eq AttrVal($name,'fakeSCaddr','222222'))) + { + Log3 $shash,5, $name.', auto ACK from '.$src.' - ignoring !'; + return $shash->{NAME}; + } + + if ($payload eq '00') + { + Log3 $shash,1,$name.', 00 payload from '.$src.' for '.$dst_name; + } + #else + #{ + ##Dispatch($shash, "MAX,$isToMe,Ack,$src,$payload", {}); + #} + + if (!@{$shash->{sendQueue}}) + { + if (!$dummy) + { + Log3 $shash, 5, $name.', ACK from '.$src_name.' but Send Queue is empty' if ($isToMe); + Log3 $shash, 4, $name.', ACK from '.$src_name.' to '.$dst_name if (!$isToMe); + } + else + { + Log3 $shash, 5, $name.', ACK from dummy '.$src_name.' to '.$dst_name; + } + Dispatch($shash, "MAX,$isToMe,Ack,$src,$payload", {}); + return $shash->{NAME}; + } + ################### check Send Queue ############################### + my $quickremove = undef; + for my $i (0 .. $#{$shash->{sendQueue}}) + { + my $packet = $shash->{sendQueue}[$i]; + if (($packet->{src} eq $dst) && ($packet->{dst} eq $src) && ($packet->{cnt} == hex($msgcnt))) + { + my $isnak = unpack("C",pack("H*",$payload)) & 0x80; + $packet->{sent} = $isnak ? 3 : 2; + $packet->{iodev} = $hash->{NAME}; # ToDo : warum wird hier das iodev nachgezogen ? + + if (!$isnak) + { + $quickremove = $i if ($packet->{cmd} eq 'PairPong'); # das muss nicht später noch durch MAX_Parse + Log3 $shash, 5, $name.', ACK from '.$src_name.' for cmd '.$packet->{cmd}.' , packet will be removed soon'; + } + Log3 $shash, 4, $name.', NACK from '.$src_name.' for cmd '.$packet->{cmd}.' !' if ($isnak); + } + # ToDo : warum machen wir bei einem Treffer nicht jetzt sofort die SQ leer ? + } + + if (defined($quickremove)) + { + splice @{$shash->{sendQueue}}, $quickremove, 1 if (defined($quickremove)); # Remove from Queue, hat kein callBack und muss nicht durch MAX ! + Log3 $shash, 5, $name.', delete packet Index '.$quickremove.' in SendQueue direct !'; + } + # Handle outgoing messages to that ShutterContact. It is only awake shortly + # after sending an Ack to a PairPong + # ToDo : das kann nicht sein, mit ELV Firmware schickt der Cube das AddLinkPartner + # an den FK nachdem dieser sein letztes Status Telegramm an seine Peers geschickt hat ! + + if (exists($modules{MAX}{defptr}{$src}) && $modules{MAX}{defptr}{$src}{type} eq "ShutterContact") + { + Log3 $shash, 3, $name.', got ACK from ShutterContact '.$src_name.' , checking SendQueue now !'; + CUL_MAX_SQH($shash, $src); + } + + Dispatch($shash, "MAX,$isToMe,Ack,$src,$payload", {}); + return $shash->{NAME}; + } #$msgType eq "Ack" + elsif ($msgType eq 'TimeInformation') + { + if ($isToMe) + { + # This is a request for TimeInformation send to us + # Log3 $hash, 4, "CMA_Parse, got request for TimeInformation from $src_name"; + # CUL_MAX_SendTimeInformation($shash, $src); + + if (length($payload) > 0) + { + my ($f1,$f2,$f3,$f4,$f5) = unpack("CCCCC",pack("H*",$payload)); + #For all fields but the month I'm quite sure + my $year = $f1 + 2000; + my $day = $f2; + my $hour = ($f3 & 0x1F); + my $min = $f4 & 0x3F; + my $sec = $f5 & 0x3F; + my $month = (($f4 >> 6) << 2) | ($f5 >> 6); #this is just guessed + + my $timestamp = eval + { + use Time::Local; + return timelocal($sec, $min, $hour, $day, $month - 1, $year - 1900); + }; + + my $timeDiff = int(time()-$timestamp); + if ($timeDiff > AttrNum($shash->{NAME},'broadcastTimeDiff',10)) + { + Log3 $shash, 4, "$name, TimeInformation from $src_name $timeDiff seconds out of sync. Sending correct Information! Received Timestamp (in GMT): $hour:$min:$sec $day.$month.$year"; + CUL_MAX_SendTimeInformation($shash, $src); + readingsSingleUpdate($defs{$src_name},'lastTimeSync',TimeNow(),1); + readingsSingleUpdate($shash,'lastTimeSync',$src_name,1) if ($debug); + } + else + { + Log3 $shash, 4, $name.', TimeInformation from '.$src_name.' to now is only '.$timeDiff.' seconds. - ignoring !'; + return $shash->{NAME}; + } + } + else + { + Log3 $shash, 4, $name.', TimeInformation-Request from '.$src_name.' without timestamp in payload. Sending back correct Timestamp'; + CUL_MAX_SendTimeInformation($shash, $src); + readingsSingleUpdate($defs{$src_name},'lastTimeSync',TimeNow(),1); + readingsSingleUpdate($shash,'lastTimeSync',$src_name,1) if ($debug); + } + } + elsif (length($payload) > 0) # nicht direkt an uns, aber mit payload + { + my ($f1,$f2,$f3,$f4,$f5) = unpack("CCCCC",pack("H*",$payload)); + #For all fields but the month I'm quite sure + my $year = sprintf("%4d",$f1 + 2000); + my $day = sprintf("%02d",$f2); + my $hour = sprintf("%02d",($f3 & 0x1F)); + my $min = sprintf("%02d",$f4 & 0x3F); + my $sec = sprintf("%02d",$f5 & 0x3F); + my $month = sprintf("%02d",(($f4 >> 6) << 2) | ($f5 >> 6)); #this is just guessed + my $unk1 = $f3 >> 5; + my $unk2 = $f4 >> 6; + my $unk3 = $f5 >> 6; + # I guess the unk1,2,3 encode if we are in DST? + Log3 $shash, 4, $name.', TimeInformation from '.$src_name.' to '.$dst_name." : $hour:$min:$sec $day.$month.$year , unknown ($unk1, $unk2, $unk3)"; + } + } #$msgType eq "TimeInformation + elsif ($msgType eq 'PairPing') + { + my ($firmware,$type,$testresult,$serial) = unpack("CCCa*",pack("H*",$payload)); + # What does testresult mean? + # ToDo : eine der Variablen kann undef sein bei zerstörten Telegrammen. + Log3 $shash, 4, "$name, PairPing (dst $dst, pairmode $shash->{pairmode}), firmware $firmware, type $device_types{$type}, testresult $testresult, serial $serial"; + + # There are two variants of PairPing: + # 1. It has a destination address of "000000" and can be paired to any device. + # + # 2. It is sent after changing batteries or repressing the pair button (without factory reset) and has a destination address of the last paired device. + # We can answer it with PairPong and even get an Ack, but it will still not be paired to us. + # A factory reset (originating from the last paired device) is needed first. + + + if (exists($modules{MAX}{defptr}{$src})) # xxx + { + # OK , das Gerät kennen wir schon. Reden wir überhaupt mit ihm ? + my $dhash = $modules{MAX}{defptr}{$src}; + if (AttrNum($src_name,'dummy','0')) + { + Log3 $shash,3 , $name.', device '.$src_name.' want a '.($isToMe ? 'repairing' : 'pairing').' but it is already set to an '.(AttrNum($src_name,'dummy','0') ? 'dummy' : 'ignored').' device - ignoring !'; + return $shash->{NAME}; + } + } + + if (($dst ne '000000') && !$isToMe) + { + readingsSingleUpdate($modules{MAX}{defptr}{$src},'PairedTo',$dst,1) if (exists($modules{MAX}{defptr}{$src})); + Log3 $shash,3 , $name.', device '.$src_name.' want to be re-paired to '.$dst_name.', not to us ['.$shash->{addr}.'] - ignoring !'; + return $shash->{NAME}; + } + + # If $isToMe is true, this device is already paired and just wants to be reacknowledged + # If we already have the device created but it was reseted (batteries changed?), we directly re-pair (without pairmode) + if ($shash->{pairmode} || $isToMe || exists($modules{MAX}{defptr}{$src})) + { + Log3 $shash, 3, $name.', ' . ($isToMe ? 'Re-Pairing' : 'Pairing') . " device $src_name of type $device_types{$type} with serial $serial"; + Dispatch($shash, "MAX,$isToMe,define,$src,$device_types{$type},$serial,0", {}); # ToDo : steckt hier die groupID 0 ? + + # Set firmware and testresult on device + my $dhash = $modules{MAX}{defptr}{$src}; + #$modules{MAX}{defptr}{$src}->{NAME} = $src_name if (defined($dhash) && (!exists($modules{MAX}{defptr}{$src}->{NAME}))); + + if (defined($dhash)) + { + readingsBeginUpdate($dhash); + readingsBulkUpdate($dhash, "firmware", sprintf("%u.%u",int($firmware/16),$firmware%16)); + readingsBulkUpdate($dhash, "testresult", $testresult); + readingsBulkUpdate($dhash, "PairedTo", $dst); + readingsBulkUpdate($dhash, "SerialNr", $serial); + readingsEndUpdate($dhash, 1); + } + + # Send after dispatch the define, otherwise Send will create an invalid device + # ToDo : was ist hier genau gemeint ? + CUL_MAX_Send($shash, 'PairPong', $src, '00'); + + return $shash->{NAME} if ($isToMe); # if just re-pairing, default values are not restored (I checked) + + # This are the default values that a device has after factory reset or pairing + if ($device_types{$type} =~ /HeatingThermostat.*/) + { + Dispatch($shash, "MAX,$isToMe,HeatingThermostatConfig,$src,17,21,30.5,4.5,$defaultWeekProfile,80,5,0,12,15,100,0,0,12", {}); + } + elsif ($device_types{$type} eq "WallMountedThermostat") + { + Dispatch($shash, "MAX,$isToMe,WallThermostatConfig,$src,17,21,30.5,4.5,$defaultWeekProfile,80,5,0,12", {}); + } + } # pairmode , isToMe, exists + } + #elsif (grep /^$msgType$/, ("ShutterContactState", "WallThermostatState", "WallThermostatControl", "ThermostatState", "PushButtonState", "SetTemperature")) + elsif (($msgType eq 'ShutterContactState') + || ($msgType eq 'WallThermostatState') + || ($msgType eq 'WallThermostatControl') + || ($msgType eq 'ThermostatState') + || ($msgType eq 'PushButtonState') + || ($msgType eq 'SetTemperature')) + { + Dispatch($shash, "MAX,$isToMe,$msgType,$src,$payload", {}); # istome ? + #if (($msgType eq "ShutterContactState") && int($shash->{sq}) )# ToDo Test FK + #{ + # noch prüfen : macht es einen Unterschied ob dispatch davor oder danach steht ? + #Log3 $shash, 3, $name.', '.$src_name.' is a ShutterContact, checking packet in SendQueue'; + #CUL_MAX_SQH($shash, $src); + #} + #Dispatch($shash, "MAX,$isToMe,$msgType,$src,$payload", {}); # istome ? + } + else { Log3 $shash,3 , 'CM_Parse, unhandled message '.$msgType.' from '.$src_name.' to '.$dst_name.', groupid : '.$groupid.' , payload : '.$payload.' - ignoring !'; } + } + else { Log3 $shash, 2, 'CM_Parse, unhandled message type '.$msgTypeRaw.' from '.$src_name.' to '.$dst_name.' - ignoring !'; } + + return $shash->{NAME}; +} + +#All inputs are hex strings, $cmd is one from %msgCmd2Id +sub CUL_MAX_Send +{ + my ($hash, $cmd, $dst, $payload, %opts) = @_; + my $name = $hash->{NAME}; + + my $flags = (exists($opts{flags})) ? $opts{flags} : '00'; + my $groupId = (exists($opts{groupId})) ? $opts{groupId} : '00'; #ToDo : GroupID vom Device holen ! + my $src = (exists($opts{src})) ? $opts{src} : $hash->{addr}; + my $callbackParam = (exists($opts{callbackParam})) ? $opts{callbackParam} : undef; + + my $src_name = (exists($modules{MAX}{defptr}{$src}) && exists($modules{MAX}{defptr}{$src}->{NAME})) ? $modules{MAX}{defptr}{$src}->{NAME} : 'MAX_'.$src; + my $dst_name = (exists($modules{MAX}{defptr}{$dst}) && exists($modules{MAX}{defptr}{$dst}->{NAME})) ? $modules{MAX}{defptr}{$dst}->{NAME} : 'MAX_'.$dst; + my $type = (exists($modules{MAX}{defptr}{$dst}) && exists($modules{MAX}{defptr}{$dst}->{type})) ? $modules{MAX}{defptr}{$dst}->{type} : 'unknown'; + + my $dhash = $modules{MAX}{defptr}{$dst}; + + # Bei Brodcast Zielen ist es etwas anders + if ($dst eq '000000') + { + $dst_name = 'Broadcast'; + $dhash = $modules{MAX}{defptr}{$src}; + } + + # Fix : Use of uninitialized value $payload in concatenation (.) or string nach Device Factory Reset + #$payload = '' if (!defined($payload)); + $payload //= ''; + $dhash->{READINGS}{msgcnt}{VAL} ++; + $dhash->{READINGS}{msgcnt}{VAL} &= 0xFF; + $dhash->{READINGS}{msgcnt}{TIME} = TimeNow(); # Todo : muss das sein ??? + + my $msgcnt = sprintf("%02x",$dhash->{READINGS}{msgcnt}{VAL}); + + my $cul = AttrVal($dst_name,'CULdev','none'); + + my $packet = $msgcnt . $flags . $msgCmd2Id{$cmd} . $src . $dst . $groupId . $payload; + + Log3 $hash, 4, "$name, send -> cmd:$cmd, msgcnt:$msgcnt, flags:$flags, Cmd2id:$msgCmd2Id{$cmd}, src:$src_name , dst:$dst_name , gid:$groupId , payload:$payload , cul:$cul"; + + # prefix length in bytes + $packet = sprintf("%02x",length($packet)/2) . $packet; + + Log3 $hash, 5, "$name, send packet: $packet"; + my $timeout = gettimeofday()+$ackTimeout; + + my $l='0'; + my $win = '-1'; + my @io = split(',',AttrVal($name,'IOgrp','')); + + #if ((@io > 1) && !$cul) + #{ + #if ( exists($dhash->{$io[0]}) && exists($dhash->{$io[1]})) + #{ + + #if ( ($dhash->{$io[0].'_RAWMSG'} eq $dhash->{$io[1].'_RAWMSG'}) + # && ($dhash->{$io[0].'_TIME'} eq $dhash->{$io[1].'_TIME'})) + #{ + # $l = '2' if ($dhash->{$io[0].'_RSSI'} < $dhash->{$io[1].'_RSSI'}); + #$l = '1' if ($dhash->{$io[0].'_RSSI'} > $dhash->{$io[1].'_RSSI'}); + #} + + #$win = $io[1] if $l == 2; + #$win = $io[0] if $l == 1; + + #Log3 $hash, 4, "$name, last input win $l - $win"; + #Log3 $hash, 5, "$name, $dhash->{$io[0].'_RAWMSG'} | $dhash->{$io[1].'_RAWMSG'}"; + #} + #} + my $aref = $hash->{sendQueue}; + push(@{$aref}, { "packet" => $packet, + "src" => $src, + "dst" => $dst, + "cnt" => hex($msgcnt), + "time" => $timeout, + "sent" => "0", + "cmd" => $cmd, + "win" => $win, + "CUL" => $cul, + "src_name" => $src_name, + "dst_name" => $dst_name, + "callbackParam" => $callbackParam, + "type" => $type + }); + + # Call CUL_MAX_SendQueueHandler if we just enqueued the only packet + # otherwise it is already in the InternalTimer list + + $hash->{sq} = int(@{$hash->{sendQueue}}); + CUL_MAX_SQH($hash,undef) if (int(@{$hash->{sendQueue}}) == 1); + return; +} + + +sub CUL_MAX_SendTimeInformation +{ + my $hash = shift; + my $addr = shift; + my $payload = shift; + #$payload = CUL_MAX_GetTimeInformationPayload() if (!defined($payload)); + $payload //= CUL_MAX_GetTimeInformationPayload(); + Log3 $hash, 5, "$hash->{NAME}, Broadcast time to $addr"; + CUL_MAX_Send($hash, "TimeInformation", $addr, $payload, flags => "04"); + return; +} + +sub CUL_MAX_BroadcastTime +{ + my $hash = shift; + my $manual = shift; + my $name = $hash->{NAME}; + my $payload = CUL_MAX_GetTimeInformationPayload(); + my @used_slots = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ); + + Log3 $hash, 5, "$name, BroadcastTime payload : $payload"; + + # First, lookup all thermstats for their current TimeInformationHour timeslot (0-11) + foreach my $addr (keys %{$modules{MAX}{defptr}}) + { + my $dhash = $modules{MAX}{defptr}{$addr}; + if (exists($dhash->{IODev}) + && defined($dhash->{IODev}) + && $dhash->{IODev} == $hash + && $dhash->{type} =~ /.*Thermostat.*/ ) + { + my $h = InternalVal($dhash->{NAME},'TimeSlot','-1'); + $used_slots[$h]++ if (( $h < 12 ) && ( $h > -1)); + } + } + + foreach my $addr (keys %{$modules{MAX}{defptr}}) + { + my $dhash = $modules{MAX}{defptr}{$addr}; + # Check that + # 1. the MAX device dhash uses this MAX_CUL as IODev + # 2. the MAX device is a Wall/HeatingThermostat + # 3. not ignored or a dummy + + if (exists($dhash->{IODev}) + && defined($dhash->{IODev}) + && $dhash->{IODev} == $hash + && $dhash->{type} =~ /.*Thermostat.*/ + && $dhash->{devtype} != 7 + && !AttrNum($dhash->{NAME}, 'ignore', 0) + && !AttrNum($dhash->{NAME}, 'dummy', 0)) + { + my $h = InternalVal($dhash->{NAME},'TimeSlot','-1'); + if (( $h < 0 ) || ( $h > 11)) + { + #Find the used_slot with the smallest number of entries + $h = (sort { $used_slots[$a] cmp $used_slots[$b] } 0 .. 11)[0]; + $dhash->{TimeSlot} = $h; + Log3 $hash, 4, "$name, new timeslot $h for device ".$dhash->{NAME}; + $used_slots[$h]++; + } + + if ( [gmtime()]->[2] % 12 == $h ) + { + CUL_MAX_SendTimeInformation($hash, $addr, $payload); + readingsSingleUpdate($dhash,'lastTimeSync',TimeNow(),1); + readingsSingleUpdate($hash,'lastTimeSync',$dhash->{NAME},1) if (AttrNum($name,'debug',0)); + Log3 $hash, 4, "$name, periodical TimeInformation sent to ".$dhash->{NAME}; + } + } + } + + #Check again in 1 hour if some thermostats with the right TimeInformationHour need updating + InternalTimer(gettimeofday() + 3600, "CUL_MAX_BroadcastTime", $hash, 0) unless(defined($manual)); + return; +} + +sub CUL_MAX_Alive +{ + my $hash = shift; + + foreach (keys %{$modules{MAX}{defptr}}) + { + my $dhash = $modules{MAX}{defptr}{$_}; + if (exists($dhash->{IODev}) && ($dhash->{IODev} == $hash) && exists($dhash->{'.actCycle'})) + { + my $ac = InternalVal($dhash->{NAME},'.actCycle','0'); + my $diff = int(time() - ReadingsNum($dhash->{NAME},'.lastact', 0)); + + if ($ac && ($diff > $ac)) + { + readingsSingleUpdate($dhash,'Activity',($diff > ($ac*3)) ? 'dead' : 'timeout',1); + } #else { readingsSingleUpdate($dhash,'Activity',$diff,1); } nur Test + } + } + + InternalTimer(gettimeofday() + 300, 'CUL_MAX_Alive',$hash,0); + return; +} + +sub CUL_MAX_GetTimeInformationPayload +{ + my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime(time()); + $mon += 1; #make month 1-based + #month encoding is just guessed + #perls localtime gives years since 1900, and we need years since 2000 + return unpack("H*",pack("CCCCC", $year - 100, $day, $hour, $min | (($mon & 0x0C) << 4), $sec | (($mon & 0x03) << 6))); +} + +# This can be called for two reasons: +# 1. @sendQueue was empty, CUL_MAX_Send added a packet and then called us +# 2. We sent a packet from @sendQueue and now the ackTimeout is over. +# The packet my still be in @sendQueue (timed out) or removed when the Ack was received. +# Arguments are hash and responseToShutterContact. +# If SendQueueHandler was called after receiving a message from a shutter contact, responseToShutterContact +# holds the address of the respective shutter contact. Otherwise, it is empty. +sub CUL_MAX_SQH +{ + my $hash = shift; + my $responseToShutterContact = shift; + my $name = $hash->{NAME}; + + $hash->{sq} = int(@{$hash->{sendQueue}}); + + if (defined($responseToShutterContact)) + { + Log3 $hash, 5, "$name, Send Queue ". $hash->{sq} . (($hash->{sq}==1) ? ' packet' : ' packets') ." in queue , rTSC : $responseToShutterContact"; + } + else + { + Log3 $hash, 5, "$name, Send Queue ". $hash->{sq} . (($hash->{sq}==1) ? ' packet' : ' packets') ." in queue"; + } + return if (!$hash->{sq}); #nothing to do + + my $timeout = gettimeofday(); # reschedule immediatly + + #Check if we have an IODev + if (!defined($hash->{IODev})) + { + Log3 $hash, 1, "$name, did not find suitable IODev (CUL etc. in rfmode MAX), cannot send! You may want to execute 'attr $hash->{NAME} IODev SomeCUL'"; + # Maybe some CUL will appear magically in some seconds + # At least we cannot quit here with an non-empty queue, so we have two alternatives: + # 1. Delete the packet from queue and quit -> packet is lost + # 2. Wait, recheck, wait, recheck ... -> a lot of logs + + #InternalTimer($timeout+60, "CUL_MAX_SendQueueHandler", $hash, 0); + #$hash->{sendQueue} = []; + $hash->{sendQueue} = []; + $hash->{sq} = 0; + return; + } + + my $debug = AttrNum($name,'debug',0); + + my ($packet, $pktIdx, $dst); + + for ($pktIdx = 0; $pktIdx < @{$hash->{sendQueue}}; $pktIdx ++) + { + $packet = $hash->{sendQueue}[$pktIdx]; + + if (defined($responseToShutterContact)) + { + # Find a packet to the ShutterContact in $responseToShutterContact + # Aufruf Sonderfall + last if ($packet->{dst} eq $responseToShutterContact); + } + else + { + #We cannot sent packets to a ShutterContact directly, everything else is possible + last if (($packet->{cmd} eq 'PairPong') + || ($packet->{sent} != 0) + || ($packet->{type} ne 'ShutterContact')); + #$packetForShutterContactInQueue = $modules{MAX}{defptr}{$packet->{dst_name}}; + } + } # for + + if ($pktIdx == @{$hash->{sendQueue}} && !defined($responseToShutterContact)) + { + Log3 $hash, 4, "$name, Send Queue packet for ShutterContact ".$packet->{dst_name}." exists"; + #. Please trigger a window action (open or close the window) to wake up the respective ShutterContact and let it receive the packet."; + $timeout += 3; + InternalTimer($timeout, "CUL_MAX_SQH", $hash, 0); + #Log3 $hash, 5, $name.', Send Queue in not empty yet, next run in '.sprintf("%.1f",($timeout-gettimeofday())).' seconds'; + # ToDo : checken wir hier immer nur auf das letzte Packet in der Queue ? + return; + } + + if ( $packet->{sent} == 0 ) + { + my $io_name = $hash->{IODev}{NAME}; + + if (($packet->{CUL} ne 'none') && ($packet->{CUL} ne $io_name) && AttrVal($name,'IOgrp','')) + { + Log3 $hash,4,$name.', Send Queue packet to '.$packet->{dst_name}.' needs '.$packet->{CUL}.' but current IODev is '.$io_name; + AssignIoPort($hash,$packet->{CUL}); # falls das schief geht nehmen wir halt das attr IODev + if ($io_name ne $hash->{IODev}{NAME}) + { + $io_name = $hash->{IODev}{NAME}; + $hash->{'.VERSION'} = CUL_MAX_Check($hash); + Log3 $hash,4,$name.', Send Queue IODev switched to '.$io_name.' with version '.$hash->{'.VERSION'}; + } + else { Log3 $hash,3,$name.', Send Queue unable to change IODev !'; } + } + + + # Need to send it first + # We can use fast sending without preamble on culfw 1.53 and higher when the devices has been woken up + my $needPreamble = (($hash->{'.VERSION'} < 153) + || (!defined($responseToShutterContact) && + (!defined($modules{MAX}{defptr}{$packet->{dst}}{wakeUpUntil}) + || $modules{MAX}{defptr}{$packet->{dst}}{wakeUpUntil} < gettimeofday()))) ? 1 : 0; + + #my $needPreamble = ($hash->{'.VERSION'} < 153) ? 1 : 0; + + $needPreamble = 1; + # Send to CULs + + my $last_h = (exists($hash->{IODev}{NR_CMD_LAST_H})) ? $hash->{IODev}{NR_CMD_LAST_H} : 0; + readingsSingleUpdate($hash,$io_name.'_cmd_last_h',int($last_h),1) if ($debug); + + my ($credit10ms) = (CommandGet('',$io_name.' credit10ms') =~ /[^ ]* [^ ]* => (.*)/); + + if (!defined($credit10ms) || $credit10ms eq 'No answer') + { + Log3 $hash, 1, $name.', Send Queue error CUL '.$io_name.' did not answer request for current credits. Waiting 5 seconds'; + $timeout += 5; + } + else + { + readingsSingleUpdate($hash,$io_name.'_credit10ms',int($credit10ms),1) if ($debug); + # We need 1000ms for preamble + len in bits (=hex len * 4) ms for payload. Divide by 10 to get credit10ms units + # keep this in sync with culfw's code in clib/rf_moritz.c! + my $necessaryCredit = ceil(100*$needPreamble + (length($packet->{packet})*4)/10); + Log3 $hash, 5, $name.', Send Queue '.$io_name.' -> needPreamble: '.$needPreamble.', necessaryCredit: '.$necessaryCredit.', credit10ms: '.$credit10ms.', '.$io_name.' CMD_LAST_H: '.$last_h; + + if ( defined($credit10ms) && $credit10ms < $necessaryCredit ) + { + my $waitTime = $necessaryCredit-$credit10ms; # we get one credit10ms every second + $timeout += $waitTime + 1; + Log3 $hash, 2, $name.', '.$io_name.' not enough credit! credit10ms is '.$credit10ms.', but we need '.$necessaryCredit.'. Waiting '.$waitTime.' seconds. Currently '.@{$hash->{sendQueue}}.' messages are waiting to be sent'; + } + else + { + # Update TimeInformation payload. It should reflect the current time when sending, + # not the time when it was enqueued. A low credit10ms can defer such a packet for multiple minutes + if ( $msgId2Cmd{substr($packet->{packet},6,2)} eq "TimeInformation" ) + { + Log3 $hash, 5, $name.', Send Queue updating packet TimeInformation payload'; + substr($packet->{packet},22) = CUL_MAX_GetTimeInformationPayload(); + } + + IOWrite($hash, '', ($needPreamble ? 'Zs' : 'Zf') . $packet->{packet}); + Log3 $hash, 4, $name.', Send Queue packet send : '.($needPreamble ? 'Zs' : 'Zf').$packet->{packet}.' to '.$packet->{dst_name}.' with '.$io_name; + + if ($packet->{dst} ne '000000') + { + $packet->{sent} = 1; + $packet->{sentTime} = gettimeofday(); + if (!defined($packet->{retryCnt})) + { + $packet->{retryCnt} = $maxRetryCnt; + } + $timeout += 0.5; # recheck for Ack in 0.5 seconds + } + else # Broadcast Nachricht sofort wieder löschen, wir bekommen nie ein ACK + { + splice @{$hash->{sendQueue}}, $pktIdx, 1; # Remove from Queue + } + } + } # $credit10ms ne "No answer" + } # paket send == 0 + + if ( $packet->{sent} == 1 ) + { # Already sent it, got no Ack + if ( $packet->{sentTime} + $ackTimeout < gettimeofday() ) + { + # ackTimeout exceeded + if ( $packet->{retryCnt} > 0 ) + { + Log3 $hash, 4, $name.', Send Queue retry '.$packet->{dst_name}.' for '.$packet->{cmd}.' count: '.$packet->{retryCnt}; + $packet->{sent} = 0; + $packet->{retryCnt}--; + $timeout += 3; + + readingsSingleUpdate($hash, $packet->{CUL}.'_retry', (ReadingsNum($name, $packet->{CUL}.'_retry', '0') + 1),1) if ($debug); + readingsSingleUpdate($defs{$packet->{dst_name}}, $packet->{CUL}.'_retry', (ReadingsNum($packet->{dst_name}, $packet->{CUL}.'_retry', '0') + 1),1) if ($debug); + } + else + { + Log3 $hash, 3, $name.', Send Queue missing ack from '.$packet->{dst_name}.' for '.$packet->{cmd}.', removing from queue'; + splice @{$hash->{sendQueue}}, $pktIdx, 1; # Remove from Queue + + readingsSingleUpdate($hash, $packet->{CUL}.'_lost', (ReadingsNum($name, $packet->{CUL}.'_lost', '0') + 1),1) if ($debug); + readingsSingleUpdate($defs{$packet->{dst_name}}, $packet->{CUL}.'_lost', (ReadingsNum($packet->{dst_name}, $packet->{CUL}.'_lost', '0') + 1),1) if ($debug); + } + } + else + { + # Recheck for Ack + $timeout += 0.5; + } + } + + if ( $packet->{sent} == 2 ) + { # Got ack + Log3 $hash, 4, $name.', Send Queue ACK from '.$packet->{dst_name}.' for '.$packet->{cmd}.', removing from queue'; + + if (defined($packet->{callbackParam})) + { + #Log3 $hash ,1 , "SQH ACK with callback : ".$packet->{callbackParam}; + Dispatch($hash, "MAX,1,Ack$packet->{cmd},$packet->{dst},$packet->{callbackParam}", {}); + } + splice @{$hash->{sendQueue}}, $pktIdx, 1; # Remove from Queue + } + + if ( $packet->{sent} == 3 ) + { # Got nack + Log3 $hash, 4, $name.', Send Queue NACK from '.$packet->{dst_name}.' for '.$packet->{cmd}.', removing from queue'; + splice @{$hash->{sendQueue}}, $pktIdx, 1; # Remove from Queue + readingsSingleUpdate($hash, $packet->{CUL}.'_nack', (ReadingsNum($name, $packet->{CUL}.'_nack', '0') + 1),1) if ($debug); + readingsSingleUpdate($defs{$packet->{dst_name}}, $packet->{CUL}.'_nack', (ReadingsNum($packet->{dst_name}, $packet->{CUL}.'_nack', '0') + 1),1) if ($debug); + } + + $hash->{sq} = int(@{$hash->{sendQueue}}); + Log3 $hash, 5, $name.', Send Queue is now empty' if (!$hash->{sq}); + return if (!$hash->{sq}); # everything done , empty sendQueue + return if (defined($responseToShutterContact)); # this was not called from InternalTimer + #Log3 $hash, 5, $name.', Send Queue in not empty yet, next run in '.sprintf("%.1f",($timeout-gettimeofday())).' seconds'; + InternalTimer($timeout, 'CUL_MAX_SQH', $hash, 0); + return; +} + +sub CUL_MAX_RenameFn +{ + my $new = shift; + my $old = shift; + for my $d (devspec2array('TYPE=MAX')) + { + my $hash = $defs{$d}; + next if (!$hash); + #$hash->{DEF} =~ s/^$old:/$new:/; + $attr{$d}{IODev} = $new if (AttrVal($d,"IODev","") eq $old); + } + #MAX_renameIoDev($new, $old); + return; +} + +1; + + +=pod +=begin html + + +

CUL_MAX

+ +=end html +=device +=item summary Uses a CUL (or compatible) to control MAX! devices. +=item summary_DE Benutzt einen CUL (oder kompatibles Gerät) um MAX! Geräte zu steuern. +=begin html_DE + + +

CUL_MAX

+ + +=end html_DE +=cut