diff --git a/fhem/CHANGED b/fhem/CHANGED index d599318fe..746e442ca 100644 --- a/fhem/CHANGED +++ b/fhem/CHANGED @@ -1,5 +1,6 @@ # Add changes at the top of the list. Keep it in ASCII, and 80-char wide. # Do not insert empty lines here, update check depends on it. + - feature: 10_KNX: KNX_scan Utility function - bugfix: 82_LGTV_WebOS: rewrite and change code, fix bugs of older version - bugfix: 88_HMCCU: Bugfixes and improvements - bugfix: 73_.*Calculator: bugfix - Correct unit for SymcCounter diff --git a/fhem/FHEM/10_KNX.pm b/fhem/FHEM/10_KNX.pm index 0cd0ed588..3dcebf888 100644 --- a/fhem/FHEM/10_KNX.pm +++ b/fhem/FHEM/10_KNX.pm @@ -66,6 +66,10 @@ # removed examples from cmdref -> wiki # MH 20211118 E04.90 fix dpt10 now, fix dpt19 workingdays # fix dpt3 encode +# MH 20220107 E05.00 feature: add support for FHEM2FHEM as IO-Device +# E05.01 feature: utitity KNX_scan +# corrections cmd-ref +# optimize replaceByRegex package FHEM::KNX; ## no critic 'package' @@ -109,18 +113,15 @@ BEGIN { AnalyzePerlCommand AnalyzeCommandChain EvalSpecials fhemTimeLocal) ); + # export to main context (with different name) + GP_Export( + qw(Initialize KNX_scan) + ); } -### export to main context (with different name) -GP_Export(qw(Initialize)); - #string constants my $MODELERR = "MODEL_NOT_DEFINED"; # for autocreate -#my $ONFORTIMER = "on-for-timer"; -#my $OFFFORTIMER = "off-for-timer"; -#my $ONUNTIL = "on-until"; -#my $OFFUNTIL = "off-until"; my $BLINK = "blink"; my $TOGGLE = "toggle"; my $RAW = "raw"; @@ -151,7 +152,7 @@ my $PAT_DPT1_PAT = '(on)|(off)|(0?1)|(0?0)'; my $PAT_DTSEP = qr/(?:_)/ix; # date/time separator my $PAT_DATE = qr/(3[01]|[0-2]?[0-9])\.(1[0-2]|0?[0-9])\.((?:19|20)[0-9][0-9])/ix; #pattern for time -my $PAT_TIME = qr/(2[0-4]|[01]{0,1}[0-9]):([0-5]{0,1}[0-9]):([0-5]{0,1}[0-9])/ix; #E04.90 +my $PAT_TIME = qr/(2[0-4]|[01]{0,1}[0-9]):([0-5]{0,1}[0-9]):([0-5]{0,1}[0-9])/ix; #my $PAT_TIME = qr/(2[0-4]|[0?1][0-9]):([0?1-5][0-9]):([0?1-5][0-9])/ix; my $PAT_DPT16_CLR = qr/>CLR{rawDevice}; #name of fake local IO-dev or remote IO-dev + if (defined($rawdef)) { + return if (exists($defs{$rawdef}) && $defs{$rawdef}->{TYPE} eq 'KNXIO' && $defs{$rawdef}->{model} eq 'X'); # only if model of fake device eq 'X' + return if (exists($iohash->{'.RTYPE'}) && $iohash->{'.RTYPE'} eq 'KNXIO'); # remote TYPE is KNXIO + } + } return $aVal . ' is not a valid IO-Device for this Device'; } } # /set @@ -1017,6 +1029,11 @@ sub KNX_Parse { #gad not defined yet, give feedback for autocreate if (not (exists $modules{KNX}{defptr}{$gadCode})) { +# #E05.00 check if any autocreate device is disabled +# my @acList = devspec2array('TYPE=autocreate'); +# foreach my $acdev (@acList) { +# return q{} if (Value($defs{$acdev}) eq 'disabled'); # dont go thru "UNDEFINED...." +# } #format gad my $gad = KNX_hexToName($gadCode); #create name @@ -1151,14 +1168,15 @@ sub KNX_SetReadings { my $name = $hash->{NAME}; #append post-string, if supplied - my $suffix = AttrVal($name, "format",undef); + my $suffix = AttrVal($name, 'format', undef); $transval .= q{ } . $suffix if (defined($suffix)); - #execute regex, if defined - my $regAttr = AttrVal($name, "stateRegex", undef); - my $state = KNX_replaceByRegex ($regAttr, $rdName, $transval); - - my $logstr = (defined($state))?$state:'UNDEFINED'; - Log3 ($name, 5, "KNX_SetReadings: $name - replaced $rdName value from: $transval to $logstr") if ($transval ne $logstr); +#E05.01 #execute stateRegex + my $state = KNX_replaceByRegex ($hash, $rdName, $transval); +# my $regAttr = AttrVal($name, "stateRegex", undef); +# my $state = KNX_replaceByRegex ($regAttr, $rdName, $transval); +# +# my $logstr = (defined($state))?$state:'UNDEFINED'; +# Log3 ($name, 5, "KNX_SetReadings: $name - replaced $rdName value from: $transval to $logstr") if ($transval ne $logstr); my $lsvalue = 'fhem'; # called from set $lsvalue = KNX_hexToName2($src) if (defined($src) && ($src ne q{})); # called from parse @@ -1171,7 +1189,7 @@ sub KNX_SetReadings { #execute state-command if defined #must be placed after first reading, because it may have a reference my $deviceName = $name; #hack for being backward compatible - serve $name and $devname - my $cmdAttr = AttrVal($name, "stateCmd", undef); + my $cmdAttr = AttrVal($name, 'stateCmd', undef); if ((defined($cmdAttr)) && ($cmdAttr ne q{})) { my $newstate = KNX_eval ($hash, $gadName, $state, $cmdAttr); @@ -1184,7 +1202,7 @@ sub KNX_SetReadings { } } - readingsBulkUpdate($hash, "state", $state); + readingsBulkUpdate($hash, 'state', $state); } readingsEndUpdate($hash, 1); return; @@ -1291,12 +1309,20 @@ sub KNX_checkAndClean { return $value; } -# replace state-values Attribute: stateRegex +#E05.01 +# replace state-values by Attr stateRegex sub KNX_replaceByRegex { - my ($regAttr, $rdName, $input) = @_; + my ($hash, $rdName, $input) = @_; + my $name = $hash->{NAME}; + my $regAttr = AttrVal($name, 'stateRegex', undef); return $input if (! defined($regAttr)); +#sub KNX_replaceByRegex { +# my ($regAttr, $rdName, $input) = @_; +# +# return $input if (! defined($regAttr)); +# my $retVal = $input; #execute regex, if defined @@ -1317,7 +1343,9 @@ sub KNX_replaceByRegex { if (not defined ($regPair[1])) { #cut value - $retVal = undef; + Log3 ($name, 5, "KNX_replaceByRegex: $name - replaced $rdName value from: $input to undefined"); + return; +# $retVal = undef; } elsif ($regPair[0] eq $tempVal) { # complete match $retVal = $regPair[1]; @@ -1333,6 +1361,7 @@ sub KNX_replaceByRegex { last; } + Log3 ($name, 5, "KNX_replaceByRegex: $name - replaced $rdName value from: $input to $retVal") if ($input ne $retVal); return $retVal; } @@ -1485,8 +1514,7 @@ sub enc_dpt3 { #Step value (four-bit) my $numval = 0; my $sign = ($value >=0 )?1:0; $value = abs($value); -# my @values = qw( 75 50 25 12 6 3 1 ); - my @values = qw( 75 50 25 12 6 3 1 0); #E04.90 + my @values = qw( 75 50 25 12 6 3 1 0); foreach my $key (@values) { $numval++; if ($value >= $key) { @@ -1533,23 +1561,6 @@ sub enc_dpt9 { #2-Octet Float value sub enc_dpt10 { #Time of Day my $value = shift; my $numval = 0; -=pod - if ($value =~ m/now/ix) { - #get actual time - my ($secs,$mins,$hours,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); - #add offsets - $year+=1900; - $mon++; - # calculate offset for weekday - $wday = 7 if ($wday == 0); - $hours += 32 * $wday; - } - else { - my ($hh, $mm, $ss) = split(/:/x, $value); - $numval = $ss + ($mm << 8) + ($hh << 16); - } -=cut -#E04.90 new code my ($secs,$mins,$hours,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); # default now if ($value =~ /$PAT_TIME/ix) { ($hours,$mins,$secs) = split(/[:]/ix,$value); @@ -1632,9 +1643,8 @@ sub enc_dpt19 { #DateTime my ($secs,$mins,$hours,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($ts); $wday = 7 if ($wday eq "0"); # calculate offset for weekday $hours += ($wday << 5); # add day of week - my $status1 = 0x40; #E04.90 Fault=0, WD = 1, NWD = 0 (WD Field valid), NY = 0, ND = 0, NDOW= 0,NT=0, SUTI = 0 -# my $status1 = 0x20; # Fault=0, WD = 0, NWD = 1 (WD Field valid), NY = 0, ND = 0, NDOW= 0,NT=0, SUTI = 0 - $status1 = $status1 & 0xBF if ($wday >= 6); #E04.90 Saturday & Sunday is non working day + my $status1 = 0x40; # Fault=0, WD = 1, NWD = 0 (WD Field valid), NY = 0, ND = 0, NDOW= 0,NT=0, SUTI = 0 + $status1 = $status1 & 0xBF if ($wday >= 6); # Saturday & Sunday is non working day $status1 += 1 if ($isdst == 1); my $status0 = 0x00; # CLQ=0 $mon++; @@ -1824,6 +1834,55 @@ sub dec_dpt232 { #RGB-Code return sprintf ("%.6x",$numval); } +########## public utility functions ########## + +### get state of devices from KNX_Hardware +### called with devspec as argument +### e.g : scanKNX() / scanKNX('device1') / scanKNX('device1, dev2,dev3,...' / scanKNX('room=Kueche'), ... +### returns number of "gets" executed +#E05.01 +sub KNX_scan { + my $devs = shift; + my @devlist = (); + + $devs = 'TYPE=KNX' if (! defined($devs)); # select all + @devlist = devspec2array($devs); + + my $i = 0; #counter devices + my $j = 0; #counter devices with get + my $k = 0; #counter total get's + my $getsarr = q{}; + + foreach my $knxdef (@devlist) { + my $devhash = $defs{$knxdef}; + next if ((! defined($devhash)) || ($devhash->{TYPE} ne 'KNX') || $devhash->{DEF} =~ /MODEL_NOT_DEFINED/ix); + $i++; + my $getstring = $devhash->{GETSTRING}; + next if ((! defined($getstring)) || $getstring eq q{}); + $j++; + my @getnames = split(/\s/ix,$getstring); + + foreach my $gads (@getnames) { + my $gad = (split(/[:]/ix,$gads))[0]; + $k++; + Log3 $knxdef, 4, "scanKNXexec: [$k] get $knxdef $gad"; + $getsarr .= "$knxdef $gad,"; + } + } + Log3 undef, 3, "scanKNX: $i devices selected / $j devices with get / $k gets executing..."; + doKNX_scan($getsarr) if ($k > 0); + return $k; +} + +### issue all get cmd's - each one delayed by InternalTimer +sub doKNX_scan { + my ($devgad, $arr) = split(/,/x,shift,2); +# Log3 undef,1, "doKNX_scan: get $devgad"; + main::fhem("get $devgad"); + return if (length($arr) <= 1); + return InternalTimer(gettimeofday() + 0.2,\&doKNX_scan,$arr); # does not support array-> use string... +} + 1; @@ -1872,14 +1931,14 @@ sub dec_dpt232 { #RGB-Code

KNX

+
+ =end html =cut