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

10_KNX.pm: multiple bugfixes & changes, (Forum #122582)

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@26910 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
erwin 2022-12-27 21:08:38 +00:00
parent 5f3523098e
commit c210296dff
3 changed files with 157 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
fhem/CHANGED
View File

@ -1,5 +1,7 @@
# Add changes at the top of the list. Keep it in ASCII, and 80-char wide. # 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. # Do not insert empty lines here, update check depends on it.
- change: 00_KNXIO: minor changes, Forum #127792
- change: 10_KNX: multiple changes, Forum #122582
- change: 93_DbLog: roll out version 5.5.7, NOTE: Please read Forum - change: 93_DbLog: roll out version 5.5.7, NOTE: Please read Forum
https://forum.fhem.de/index.php/topic,130743.0.html https://forum.fhem.de/index.php/topic,130743.0.html
for information about this version for information about this version

28
fhem/FHEM/00_KNXIO.pm
View File

@ -1,4 +1,4 @@
############################################## ## no critic (Modules::RequireVersionVar) ######################################
# $Id$ # $Id$
# base module for KNX-communication # base module for KNX-communication
# idea: merge some functions of TUL- & KNXTUL-module into one and add more connectivity # idea: merge some functions of TUL- & KNXTUL-module into one and add more connectivity
@ -13,8 +13,7 @@
# FIFO - queing of incoming messages (less latency for fhem-system) read= ~4ms vs ~34ms with KNXTUL/TUL # FIFO - queing of incoming messages (less latency for fhem-system) read= ~4ms vs ~34ms with KNXTUL/TUL
# discard duplicate incoming messages # discard duplicate incoming messages
# more robust parser of incoming messages # more robust parser of incoming messages
# ################################################################################
##############################################
### changelog: ### changelog:
# 19/10/2021 01.60 initial beta version # 19/10/2021 01.60 initial beta version
# enable hostnames for mode H & T # enable hostnames for mode H & T
@ -37,11 +36,12 @@
# unify Log msgs # unify Log msgs
# 13/11/2022 modify fifo logic # 13/11/2022 modify fifo logic
# improve cmd-ref # improve cmd-ref
# xx/12/2022 change parameter parsing in define # 05/12/2022 change parameter parsing in define
# add renameFn - correct reading & attr IODev in KNX-devices after rename of KNXIO-device # add renameFn - correct reading & attr IODev in KNX-devices after rename of KNXIO-device
# change disabled handling # change disabled handling
# fix src-addr for Mode M,H # fix src-addr for Mode M,H
# change internal PhyAddr to reabable format + range checking on define. # change internal PhyAddr to reabable format + range checking on define.
# 19/12/2022 cleanup
package KNXIO; ## no critic 'package' package KNXIO; ## no critic 'package'
@ -57,7 +57,7 @@ use HttpUtils;
use GPUtils qw(GP_Import GP_Export); # Package Helper Fn use GPUtils qw(GP_Import GP_Export); # Package Helper Fn
### perlcritic parameters ### perlcritic parameters
# these ones are NOT used! (constants,Policy::Modules::RequireFilenameMatchesPackage,Modules::RequireVersionVar,NamingConventions::Capitalization) # these ones are NOT used! (constants,Policy::Modules::RequireFilenameMatchesPackage,NamingConventions::Capitalization)
### the following percritic items will be ignored global ### ### the following percritic items will be ignored global ###
## no critic (ValuesAndExpressions::RequireNumberSeparators,ValuesAndExpressions::ProhibitMagicNumbers) ## no critic (ValuesAndExpressions::RequireNumberSeparators,ValuesAndExpressions::ProhibitMagicNumbers)
## no critic (RegularExpressions::RequireDotMatchAnything,RegularExpressions::RequireLineBoundaryMatching) ## no critic (RegularExpressions::RequireDotMatchAnything,RegularExpressions::RequireLineBoundaryMatching)
@ -142,16 +142,12 @@ sub KNXIO_Define {
return InternalTimer(gettimeofday() + 0.2,\&KNXIO_openDev,$hash) if ($mode eq q{X}); return InternalTimer(gettimeofday() + 0.2,\&KNXIO_openDev,$hash) if ($mode eq q{X});
return q{KNXIO-define syntax: "define <name> KNXIO <H|M|T> <ip-address|hostname>:<port> <phy-adress>" } . "\n" . return q{KNXIO-define syntax: "define <name> KNXIO <H|M|T> <ip-address|hostname>:<port> <phy-adress>" } . "\n" .
q{ or "define <name> KNXIO S <pathToUnixSocket> <phy-adress>" } if (scalar(@arg) < 5); q{ or "define <name> KNXIO S <pathToUnixSocket> <phy-address>" } if (scalar(@arg) < 5);
my ($host,$port) = split(/[:]/ix,$arg[3]); my ($host,$port) = split(/[:]/ix,$arg[3]);
return q{KNXIO-define: invalid ip-address or port, correct syntax is: } . return q{KNXIO-define: invalid ip-address or port, correct syntax is: } .
q{"define <name> KNXIO <H|M|T> <ip-address|name>:<port> <phy-adress>"} if ($mode =~ /[MHT]/ix && $port !~ /$PAT_PORT/ix); q{"define <name> KNXIO <H|M|T> <ip-address|name>:<port> <phy-address>"} if ($mode =~ /[MHT]/ix && $port !~ /$PAT_PORT/ix);
if (exists($hash->{OLDDEF})) { # modify definition....
KNXIO_closeDev($hash);
}
if ($mode eq q{M}) { # multicast if ($mode eq q{M}) { # multicast
my $host1 = (split(/\./ix,$host))[0]; my $host1 = (split(/\./ix,$host))[0];
@ -183,12 +179,11 @@ sub KNXIO_Define {
} }
} }
my $phyaddr = (defined($arg[4]))?$arg[4]:'0.0.0'; my $phyaddr = (defined($arg[4]))?$arg[4]:'0.0.0';
# $hash->{PhyAddr} = sprintf('%05x',KNXIO_hex2addr($phyaddr));
my $phytemp = KNXIO_hex2addr($phyaddr); my $phytemp = KNXIO_hex2addr($phyaddr);
$hash->{PhyAddr} = KNXIO_addr2hex($phytemp,2); #convert 2 times for correcting input! $hash->{PhyAddr} = KNXIO_addr2hex($phytemp,2); #convert 2 times for correcting input!
KNXIO_closeDev($hash) if ($init_done); KNXIO_closeDev($hash) if ($init_done || exists($hash->{OLDDEF})); # modify definition....
$hash->{PARTIAL} = q{}; $hash->{PARTIAL} = q{};
# define helpers # define helpers
@ -215,8 +210,6 @@ sub KNXIO_Attr {
if ($cmd eq 'set' && defined($aVal) && $aVal == 1) { if ($cmd eq 'set' && defined($aVal) && $aVal == 1) {
KNXIO_closeDev($hash); KNXIO_closeDev($hash);
} else { } else {
### should work w. KNXIO_Open
# CommandModify(undef, qq{-silent $name $hash->{DEF}}); # do a defmod ...
InternalTimer(gettimeofday() + 0.2,\&KNXIO_openDev,$hash); InternalTimer(gettimeofday() + 0.2,\&KNXIO_openDev,$hash);
} }
} }
@ -430,7 +423,6 @@ sub KNXIO_ReadH {
} }
my $phyaddr = unpack('x18n',$buf); my $phyaddr = unpack('x18n',$buf);
$hash->{PhyAddr} = KNXIO_addr2hex($phyaddr,2); # correct Phyaddr. $hash->{PhyAddr} = KNXIO_addr2hex($phyaddr,2); # correct Phyaddr.
# $hash->{PhyAddr} = sprintf('%05x',$phyaddr); # correct Phyaddr.
readingsSingleUpdate($hash, 'state', 'connected', 1); readingsSingleUpdate($hash, 'state', 'connected', 1);
Log3 ($name, 3, qq{KNXIO ($name) connected}); Log3 ($name, 3, qq{KNXIO ($name) connected});
InternalTimer(gettimeofday() + 60, \&KNXIO_keepAlive, $hash); # start keepalive InternalTimer(gettimeofday() + 60, \&KNXIO_keepAlive, $hash); # start keepalive
@ -528,14 +520,12 @@ sub KNXIO_Write {
} }
elsif ($mode eq 'M') { elsif ($mode eq 'M') {
$completemsg = pack('nnnnnnnCCC*',0x0610,0x0530,$datasize + 16,0x2900,0xBCE0,$src,$dst,$datasize,0,@data); # use src addr $completemsg = pack('nnnnnnnCCC*',0x0610,0x0530,$datasize + 16,0x2900,0xBCE0,$src,$dst,$datasize,0,@data); # use src addr
# $completemsg = pack('nnnnnnnCCC*',0x0610,0x0530,$datasize + 16,0x2900,0xBCE0,0,$dst,$datasize,0,@data);
$ret = TcpServer_MCastSend($hash,$completemsg); $ret = TcpServer_MCastSend($hash,$completemsg);
} }
else { # $mode eq 'H' else { # $mode eq 'H'
# total length= $size+20 - include 2900BCEO,src,dst,size,0 # total length= $size+20 - include 2900BCEO,src,dst,size,0
$completemsg = pack('nnnCC',0x0610,0x0420,$datasize + 20,4,$hash->{KNXIOhelper}->{CCID}) . $completemsg = pack('nnnCC',0x0610,0x0420,$datasize + 20,4,$hash->{KNXIOhelper}->{CCID}) .
pack('CCnnnnCCC*',$hash->{KNXIOhelper}->{SEQUENCECNTR_W},0,0x1100,0xBCE0,$src,$dst,$datasize,0,@data); # send TunnelInd pack('CCnnnnCCC*',$hash->{KNXIOhelper}->{SEQUENCECNTR_W},0,0x1100,0xBCE0,$src,$dst,$datasize,0,@data); # send TunnelInd
# pack('CCnnnnCCC*',$hash->{KNXIOhelper}->{SEQUENCECNTR_W},0,0x1100,0xBCE0,0,$dst,$datasize,0,@data); # send TunnelInd
# Timeout function - expect TunnelAck within 1 sec! - but if fhem has a delay.... # Timeout function - expect TunnelAck within 1 sec! - but if fhem has a delay....
$hash->{KNXIOhelper}->{LASTSENTMSG} = $completemsg; # save msg for resend in case of TO $hash->{KNXIOhelper}->{LASTSENTMSG} = $completemsg; # save msg for resend in case of TO

266
fhem/FHEM/10_KNX.pm
View File

@ -1,5 +1,7 @@
############################################## ## no critic (Modules::RequireVersionVar) ######################################
# $Id$ # $Id$
################################################################################
### changelog:
# ABU 20180218 restructuring, removed older documentation # ABU 20180218 restructuring, removed older documentation
# MH 20210908 deleted part of change history # MH 20210908 deleted part of change history
# ABU 20181007 fixed dpt19 # ABU 20181007 fixed dpt19
@ -100,6 +102,12 @@
# MH 202212xx fix dpt217 range/fomatting, cmd-ref links, # MH 202212xx fix dpt217 range/fomatting, cmd-ref links,
# remove support for IODev in define # remove support for IODev in define
# modify disabled logic # modify disabled logic
# MH 20221226 device define after init_complete
# remove $hash->{DEVNAME}
# modify autocreate, get/set logic
# changed not user relevant internals to {.XXXX}
# changed DbLog_split function
# disabled StateFn
package KNX; ## no critic 'package' package KNX; ## no critic 'package'
@ -112,7 +120,7 @@ use Scalar::Util qw(looks_like_number);
use GPUtils qw(GP_Import GP_Export); # Package Helper Fn use GPUtils qw(GP_Import GP_Export); # Package Helper Fn
### perlcritic parameters ### perlcritic parameters
# these ones are NOT used! (constants,Policy::Modules::RequireFilenameMatchesPackage,Modules::RequireVersionVar,NamingConventions::Capitalization) # these ones are NOT used! (constants,Policy::Modules::RequireFilenameMatchesPackage,NamingConventions::Capitalization)
# these ones are NOT used! (ControlStructures::ProhibitCascadingIfElse) # these ones are NOT used! (ControlStructures::ProhibitCascadingIfElse)
### the following percritic items will be ignored global ### ### the following percritic items will be ignored global ###
## no critic (ValuesAndExpressions::RequireNumberSeparators,ValuesAndExpressions::ProhibitMagicNumbers) ## no critic (ValuesAndExpressions::RequireNumberSeparators,ValuesAndExpressions::ProhibitMagicNumbers)
@ -144,10 +152,8 @@ BEGIN {
fhemTimeLocal) fhemTimeLocal)
); );
} }
# export to main context # export to main context
GP_Export( GP_Export( qw(Initialize) );
qw(Initialize)
);
#string constants #string constants
my $MODELERR = 'MODEL_NOT_DEFINED'; # for autocreate my $MODELERR = 'MODEL_NOT_DEFINED'; # for autocreate
@ -427,7 +433,7 @@ sub KNX_Define {
$hash->{NAME} = $name; $hash->{NAME} = $name;
$svnid =~ s/.*\.pm\s(.+)Z.*/$1/ix; $svnid =~ s/.*\.pm\s(.+)Z.*/$1/ix;
$hash->{SVN} = $svnid; # store svn info in dev hash $hash->{'.SVN'} = $svnid; # store svn info in dev hash
my $logtxt = qq{KNX_define ($name): }; # leading txt my $logtxt = qq{KNX_define ($name): }; # leading txt
@ -442,11 +448,30 @@ sub KNX_Define {
if ( $a[int(@a) - 1] !~ m/^(?:$PAT_GAD|$PAT_GAD_HEX)/ix ) { if ( $a[int(@a) - 1] !~ m/^(?:$PAT_GAD|$PAT_GAD_HEX)/ix ) {
my $iodevCandidate = pop(@a); # remove from array, but do nothing with it! my $iodevCandidate = pop(@a); # remove from array, but do nothing with it!
my $logtxtIO = qq{$logtxt specifying IODev $iodevCandidate is deprecated in define } . my $logtxtIO = qq{$logtxt specifying IODev $iodevCandidate is deprecated in define } .
qq{- use "attr $name IODev $iodevCandidate"}; qq{- use "attr $name IODev $iodevCandidate"};
Log3 ($name, 2, $logtxtIO); Log3 ($name, 2, $logtxtIO);
return $logtxtIO if ($init_done); # allow durin start return $logtxtIO if ($init_done); # allow durin start
} }
### new wait for initdone...
$hash->{'.DEFLINE'} = join(q{ },@a); # temp store defs for define2...
return InternalTimer(gettimeofday() + 5.0,\&KNX_Define2,$hash) if (! $init_done);
return KNX_Define2($hash);
}
### continue define 5 sec after init complete!
sub KNX_Define2 {
my $hash = shift // return;
my $name = $hash->{NAME};
my $def = $hash->{'.DEFLINE'};
delete $hash->{'.DEFLINE'};
my @a = split(/\s+/x, $def);
RemoveInternalTimer($hash);
my $logtxt = qq{KNX_define2 ($name): }; # leading txt
### end new
AssignIoPort($hash); # AssignIoPort will take device from $attr{$name}{IODev} if defined AssignIoPort($hash); # AssignIoPort will take device from $attr{$name}{IODev} if defined
#reset #reset
@ -454,7 +479,7 @@ sub KNX_Define {
$hash->{GADTABLE} = {}; $hash->{GADTABLE} = {};
#delete all defptr entries for this device (defmod & copy problem) #delete all defptr entries for this device (defmod & copy problem)
KNX_delete_defptr($hash) if ($init_done); # verify with: {PrintHash($modules{KNX}->{defptr},3) } KNX_delete_defptr($hash); # verify with: {PrintHash($modules{KNX}->{defptr},3) }
#create groups and models, iterate through all possible args #create groups and models, iterate through all possible args
foreach my $i (2 .. $#a) { foreach my $i (2 .. $#a) {
@ -478,7 +503,8 @@ sub KNX_Define {
return ($logtxt . qq{no model defined for group-number $gadNo}) if(! defined($gadModel)); return ($logtxt . qq{no model defined for group-number $gadNo}) if(! defined($gadModel));
if ($gadModel eq $MODELERR) { #within autocreate no model is supplied - throw warning if ($gadModel eq $MODELERR) { #within autocreate no model is supplied - throw warning
Log3 ($name, 3, $logtxt . 'autocreate device will be disabled, correct def with valid dpt and enable device') if ($init_done); Log3 ($name, 3, $logtxt . 'autocreate device will be disabled, correct def with valid dpt and enable device');
$attr{$name}->{disable} = 1 if (AttrVal($name,'disable',0) != 1);
} }
elsif (!defined($dpttypes{$gadModel})) { #check model-type elsif (!defined($dpttypes{$gadModel})) { #check model-type
return $logtxt . qq{invalid model: $gadModel for group-number $gadNo} . return $logtxt . qq{invalid model: $gadModel for group-number $gadNo} .
@ -505,9 +531,6 @@ sub KNX_Define {
return ($logtxt . qq{invalid suffix for group-number $gadNo. Use $PAT_GAD_SUFFIX}) if (defined($gadNoSuffix) && ($gadNoSuffix !~ m/$PAT_GAD_SUFFIX/ix)); return ($logtxt . qq{invalid suffix for group-number $gadNo. Use $PAT_GAD_SUFFIX}) if (defined($gadNoSuffix) && ($gadNoSuffix !~ m/$PAT_GAD_SUFFIX/ix));
} }
#save 1st gadName for later backwardCompatibility
$hash->{FIRSTGADNAME} = $gadName if ($gadNo == 1);
###GADTABLE ###GADTABLE
#create a hash with gadCode and gadName for later mapping #create a hash with gadCode and gadName for later mapping
my $tableHashRef = $hash->{GADTABLE}; my $tableHashRef = $hash->{GADTABLE};
@ -545,7 +568,7 @@ sub KNX_Define {
if (defined ($dptDetails->{SETLIST})) { # list is given, pass it through if (defined ($dptDetails->{SETLIST})) { # list is given, pass it through
$setlist = q{:} . $dptDetails->{SETLIST}; $setlist = q{:} . $dptDetails->{SETLIST};
} }
elsif (defined ($dptDetails->{MIN}) and looks_like_number($dptDetails->{MIN})) { #number? - place slider elsif (defined ($dptDetails->{MIN}) && looks_like_number($dptDetails->{MIN})) { #number? - place slider
my $min = $dptDetails->{MIN}; my $min = $dptDetails->{MIN};
my $max = $dptDetails->{MAX}; my $max = $dptDetails->{MAX};
my $interval = int(($max-$min)/100); my $interval = int(($max-$min)/100);
@ -574,39 +597,21 @@ sub KNX_Define {
#restore list #restore list
@{$modules{KNX}->{defptr}->{$gadCode}} = @devList; @{$modules{KNX}->{defptr}->{$gadCode}} = @devList;
#create setlist/getlist for setFn / getFn #create setlist for setFn / getlist will be created during get-cmd!
my $setString = q{}; my $setString = q{};
my $getString = q{};
foreach my $key (keys %{$hash->{GADDETAILS}}) { foreach my $key (keys %{$hash->{GADDETAILS}}) {
#no set-command for listenonly or get / no get cmds for set #no set-command for get or listenonly
my $option = $hash->{GADDETAILS}->{$key}->{OPTION}; my $option = $hash->{GADDETAILS}->{$key}->{OPTION};
if (defined ($option)) { if ((defined($option) && $option eq 'set') || (! defined($option))) {
if ($option eq 'get') { $setString .= 'on:noArg off:noArg ' if (($hash->{GADDETAILS}->{$key}->{NO} == 1) && ($hash->{GADDETAILS}->{$key}->{MODEL} =~ /^(dpt1|dpt1.001)$/x));
$getString .= q{ } . $key . ':noArg'; $setString .= $key . $hash->{GADDETAILS}->{$key}->{SETLIST} . q{ };
}
elsif ($option eq 'set') {
$setString .= ' on:noArg off:noArg' if (($hash->{GADDETAILS}->{$key}->{NO} == 1) && ($hash->{GADDETAILS}->{$key}->{MODEL} =~ /^(dpt1|dpt1.001)$/x));
$setString .= q{ } . $key . $hash->{GADDETAILS}->{$key}->{SETLIST};
}
# must be listenonly, do nothing
}
else { # no option def, select all
$getString .= q{ } . $key . ':noArg';
$setString .= ' on:noArg off:noArg' if (($hash->{GADDETAILS}->{$key}->{NO} == 1) && ($hash->{GADDETAILS}->{$key}->{MODEL} =~ /^(dpt1|dpt1.001)$/x));
$setString .= q{ } . $key . $hash->{GADDETAILS}->{$key}->{SETLIST};
} }
} }
$setString =~ s/^[\s?](.*)/$1/ix; # trim leading blank $hash->{'.SETSTRING'} = $setString;
$getString =~ s/^[\s?](.*)/$1/ix;
$hash->{SETSTRING} = $setString;
$hash->{GETSTRING} = $getString;
Log3 ($name, 5, $logtxt . qq{getstring= $hash->{GETSTRING} , setstring= $hash->{SETSTRING}}); Log3 ($name, 5, qq{$logtxt setstring= $hash->{'.SETSTRING'}});
} }
#backup name for a later rename
$hash->{DEVNAME} = $name;
Log3 ($name, 5, $logtxt . 'define complete'); Log3 ($name, 5, $logtxt . 'define complete');
return; return;
} }
@ -629,45 +634,38 @@ sub KNX_Undef {
#The answer is treated as regular telegram #The answer is treated as regular telegram
############################# #############################
sub KNX_Get { sub KNX_Get {
my ($hash, $name, @args) = @_; my $hash = shift;
my $name = shift;
#determine gadName to read - use first defined GAD if no argument is supplied my $gadName = shift // KNX_gadNameByNO($hash,1); # use first defined GAD if no argument is supplied
my $gadName = $args[0] // $hash->{FIRSTGADNAME};
return qq{KNX_Get ($name): gadName not defined} if (! defined($gadName));
Log3 ($name, 3, qq{KNX_Get ($name): too much arguments. Only one argument allowed (gadName). Other Arguments are discarded.}) if (defined(shift));
#FHEM asks with a ? at startup - no action, no log - if dev is disabled: no SET/GET pulldown ! #FHEM asks with a ? at startup - no action, no log - if dev is disabled: no SET/GET pulldown !
if ($gadName =~ m/\?/x) { if ($gadName =~ m/\?/x) {
return (IsDisabled($name) == 1)?undef:qq{unknown argument choose one of $hash->{GETSTRING}}; my $getter = q{};
=pod foreach my $key (keys %{$hash->{GADDETAILS}}) {
### option for future use last if (! defined($key));
return if (IsDisabled($name) == 1); # no get option my $option = $hash->{GADDETAILS}->{$key}->{OPTION};
next if (defined($option) && $option =~ /(?:set|listenonly)/ix);
#check for a widgetoverride that we dont want in get's... $getter .= q{ } . $key . ':noArg';
my @getlist = split(/\s/gix,$hash->{GETSTRING});
my @wgoverride = split(/\s/gix,AttrVal($name,'widgetOverride',q{}));
foreach my $wgentry (@wgoverride) {
#tbT $wgentry =~ s/^([^:]).*/$1/gix;
$wgentry =~ s/(.*)[:].*/$1/gix;
@getlist = grep(! /$wgentry/, @getlist); # remove it
} }
return qq{unknown argument $cmd choose one of } . join(q{ },@getlist); $getter =~ s/^\s+//gix; #trim leading blank
=cut $getter = q{} if (IsDisabled($name) == 1);
return qq{unknown argument $gadName choose one of $getter};
} }
return qq{KNX_Get ($name): is disabled} if (IsDisabled($name) == 1); return qq{KNX_Get ($name): is disabled} if (IsDisabled($name) == 1);
Log3 ($name, 5, qq{KNX_Get ($name): -enter: CMD= $gadName}); Log3 ($name, 5, qq{KNX_Get ($name): -enter: CMD= $gadName});
#no more than 1 argument allowed #return, if unknown group
Log3 ($name, 3, qq{KNX_Get ($name): too much arguments. Only one argument allowed (gadName). Other Arguments are discarded.}) if (scalar(@args) > 1); return qq{KNX_Get ($name): invalid gadName: $gadName} if(! exists($hash->{GADDETAILS}->{$gadName}));
#get groupCode, groupAddress, option #get groupCode, groupAddress, option
my $groupc = $hash->{GADDETAILS}->{$gadName}->{CODE}; my $groupc = $hash->{GADDETAILS}->{$gadName}->{CODE};
my $group = $hash->{GADDETAILS}->{$gadName}->{GROUP}; my $group = $hash->{GADDETAILS}->{$gadName}->{GROUP};
my $option = $hash->{GADDETAILS}->{$gadName}->{OPTION}; my $option = $hash->{GADDETAILS}->{$gadName}->{OPTION};
#return, if unknown group
return qq{KNX_Get ($name): no valid address stored for gad: $gadName} if(!$groupc);
#exit if get is prohibited #exit if get is prohibited
return qq{KNX_Get ($name): did not request a value - "set" or "listenonly" option is defined.} if (defined ($option) and ($option =~ m/(set|listenonly)/ix)); return qq{KNX_Get ($name): did not request a value - "set" or "listenonly" option is defined.} if (defined ($option) and ($option =~ m/(set|listenonly)/ix));
@ -691,14 +689,16 @@ sub KNX_Set {
#FHEM asks with a "?" at startup or any reload of the device-detail-view - if dev is disabled: no SET/GET pulldown ! #FHEM asks with a "?" at startup or any reload of the device-detail-view - if dev is disabled: no SET/GET pulldown !
if(defined($cmd) && ($cmd =~ m/\?/x)) { if(defined($cmd) && ($cmd =~ m/\?/x)) {
return (IsDisabled($name) == 1)?undef:qq{unknown argument $cmd choose one of $hash->{SETSTRING}}; my $setter = exists($hash->{'.SETSTRING'})?$hash->{'.SETSTRING'}:q{};
$setter = q{} if (IsDisabled($name) == 1);
return qq{unknown argument $cmd choose one of $setter};
} }
return $thisSub . 'is disabled' if (IsDisabled($name) == 1); return $thisSub . 'is disabled' if (IsDisabled($name) == 1);
Log3 ($name, 5, $thisSub . qq{-enter: $cmd } . join(q{ }, @arg)) if (defined ($cmd));
return $thisSub . 'no parameter(s) specified for set cmd' if((!defined($cmd)) || ($cmd eq q{})); #return, if no cmd specified return $thisSub . 'no parameter(s) specified for set cmd' if((!defined($cmd)) || ($cmd eq q{})); #return, if no cmd specified
Log3 ($name, 5, $thisSub . qq{-enter: $cmd } . join(q{ }, @arg));
my $targetGadName = $cmd =~ s/^\s+|\s+$//girx; # gad-name or cmd (in old syntax) my $targetGadName = $cmd =~ s/^\s+|\s+$//girx; # gad-name or cmd (in old syntax)
if (defined ($hash->{GADDETAILS}->{$targetGadName})) { # #new syntax, if first arg is a valid gadName if (defined ($hash->{GADDETAILS}->{$targetGadName})) { # #new syntax, if first arg is a valid gadName
@ -718,14 +718,14 @@ sub KNX_Set {
my $rdName = $hash->{GADDETAILS}->{$targetGadName}->{RDNAMESET}; my $rdName = $hash->{GADDETAILS}->{$targetGadName}->{RDNAMESET};
my $model = $hash->{GADDETAILS}->{$targetGadName}->{MODEL}; my $model = $hash->{GADDETAILS}->{$targetGadName}->{MODEL};
return $thisSub . q{did not set a value - "get" or "listenonly" option is defined.} if (defined ($option) and ($option =~ m/(get|listenonly)/ix)); return $thisSub . q{did not set a value - "get" or "listenonly" option is defined.} if (defined ($option) and ($option =~ m/(?:get|listenonly)/ix));
my $value = $cmd; #process set command with $value as output my $value = $cmd; #process set command with $value as output
#Text neads special treatment - additional args may be blanked words #Text neads special treatment - additional args may be blanked words
$value .= q{ } . join (q{ }, @arg) if (($model =~ m/^dpt16/ix) and (scalar (@arg) > 0)); $value .= q{ } . join (q{ }, @arg) if (($model =~ m/^dpt16/ix) and (scalar (@arg) > 0));
#Special commands for dpt1 and dpt1.001 #Special commands for dpt1 and dpt1.001
if ($model =~ m/((dpt1)|(dpt1.001))$/ix) { if ($model =~ m/^(?:dpt1|dpt1.001)$/ix) {
(my $err, $value) = KNX_Set_dpt1($hash, $targetGadName, $cmd, @arg); (my $err, $value) = KNX_Set_dpt1($hash, $targetGadName, $cmd, @arg);
return $err if defined($err); return $err if defined($err);
} }
@ -741,9 +741,7 @@ sub KNX_Set {
Log3 ($name, 4, $thisSub . qq{cmd= $cmd , value= $value , translated= $transvale}); Log3 ($name, 4, $thisSub . qq{cmd= $cmd , value= $value , translated= $transvale});
# decode again for values that have been changed in encode process # decode again for values that have been changed in encode process
if ($model =~ m/^(dpt3|dpt10|dpt11|dpt19)/ix) { $transval = KNX_decodeByDpt($hash, $transvale, $targetGadName) if ($model =~ m/^(?:dpt3|dpt10|dpt11|dpt19)/ix);
$transval = KNX_decodeByDpt($hash, $transvale, $targetGadName);
}
#apply post processing for state and set all readings #apply post processing for state and set all readings
KNX_SetReadings($hash, $targetGadName, $transval, $rdName, undef); KNX_SetReadings($hash, $targetGadName, $transval, $rdName, undef);
@ -776,12 +774,7 @@ sub KNX_Set_oldsyntax {
return qq{an invalid gadName: $cmd was used in set-cmd}; return qq{an invalid gadName: $cmd was used in set-cmd};
} }
foreach my $key (keys %{$hash->{GADDETAILS}}) { $targetGadName = KNX_gadNameByNO($hash, $groupnr);
if (int ($hash->{GADDETAILS}->{$key}->{NO}) == int ($groupnr)) {
$targetGadName = $key;
last;
}
}
return qq{gadName not found for $groupnr} if(!defined($targetGadName)); return qq{gadName not found for $groupnr} if(!defined($targetGadName));
# all of the following cmd's need at least 1 Argument (or more) # all of the following cmd's need at least 1 Argument (or more)
@ -903,6 +896,7 @@ sub KNX_Set_dpt1 {
#In case setstate is executed, a readingsupdate is initiated #In case setstate is executed, a readingsupdate is initiated
############################# #############################
sub KNX_State { sub KNX_State {
=pod
my $hash = shift; my $hash = shift;
my $time = shift; my $time = shift;
my $reading = shift // return; my $reading = shift // return;
@ -920,7 +914,7 @@ sub KNX_State {
#write value and update reading #write value and update reading
readingsSingleUpdate($hash, $reading, $value, 1); readingsSingleUpdate($hash, $reading, $value, 1);
=cut
return; return;
} }
@ -946,6 +940,24 @@ sub KNX_Attr {
elsif ($aName eq 'IODev' && $init_done) { elsif ($aName eq 'IODev' && $init_done) {
return KNX_chkIODev($hash,$aVal); return KNX_chkIODev($hash,$aVal);
} }
=pod
# force @set for widgetoverride
# new function introduced 12/2022 by Rudi
elsif ($aName eq 'widgetOverride' ) {
my @overrides = split(/\s/ix,$aVal);
foreach my $overr (@overrides) {
### $overr =~ s/([^\@^\:]+)(?:@.*?)?:([^ ]+)?[\s]?/$1\@set:$2 /ixg; # add @set to each wgoverride
$overr =~ /([^\@^\:]+)(?:\@(?:set|get|attr))?:?([^ ]+)?[\s]?/ixg;
if (exists($hash->{GADDETAILS}->{$1}) && defined($2)) { # only for existing gadNames
$value .= qq{$1\@set:$2 };
}
else {
$value .= $overr . q{ }; # append original
}
}
@_[3] = $value; # change $aVal in caller
}
=cut
} # /set } # /set
if ($cmd eq 'del') { if ($cmd eq 'del') {
@ -968,24 +980,20 @@ sub KNX_Attr {
############################# #############################
sub KNX_DbLog_split { sub KNX_DbLog_split {
my ($event, $device) = @_; my ($event, $device) = @_;
my ($reading, $value, $unit);
#split input-string my $unit = q{}; # default
my @strings = split (q{ }, $event);
return if (not defined ($strings[0]));
#detect reading - real reading or state? # split event into reading & value
if ($strings[0] =~ m/.*:$/x) { # real reading my ($reading, $value) = split(/:\s/x, $event, 2);
$reading = shift(@strings); if (! defined($reading)) {
$reading =~ s/:$//x;
}
else {
$reading = 'state'; $reading = 'state';
} $value = $event;
}
#per default join all single pieces
$value = join(q{ }, @strings);
# split value
my @strings = split(/\s/x, $value);
$strings[0] = q{} if (! defined($strings[0]));
#numeric value? and last value non numeric? - assume unit #numeric value? and last value non numeric? - assume unit
if (looks_like_number($strings[0]) && (! looks_like_number($strings[scalar(@strings)-1]))) { if (looks_like_number($strings[0]) && (! looks_like_number($strings[scalar(@strings)-1]))) {
$value = join(q{ },@strings[0 .. (scalar(@strings)-2)]); $value = join(q{ },@strings[0 .. (scalar(@strings)-2)]);
@ -1013,9 +1021,7 @@ sub KNX_Parse {
Log3 ($ioName, 4, qq{KNX_Parse -enter: IO-name=$ioName src=} . KNX_hexToName2($src) . q{ dest=} . KNX_hexToName($gadCode) . qq{ msg=$msg}); Log3 ($ioName, 4, qq{KNX_Parse -enter: IO-name=$ioName src=} . KNX_hexToName2($src) . q{ dest=} . KNX_hexToName($gadCode) . qq{ msg=$msg});
#gad not defined yet, give feedback for autocreate #gad not defined yet, give feedback for autocreate
if (not (exists $modules{KNX}->{defptr}->{$gadCode})) { return KNX_autoCreate($iohash,$gadCode) if (! (exists $modules{KNX}->{defptr}->{$gadCode}));
return KNX_autoCreate($iohash,$gadCode);
}
#get list from device-hashes using given gadCode (==destination) #get list from device-hashes using given gadCode (==destination)
# check on cmd line with: {PrintHash($modules{KNX}->{defptr},3) } # check on cmd line with: {PrintHash($modules{KNX}->{defptr},3) }
@ -1042,24 +1048,23 @@ sub KNX_Parse {
my $getName = $deviceHash->{GADDETAILS}->{$gadName}->{RDNAMEGET}; my $getName = $deviceHash->{GADDETAILS}->{$gadName}->{RDNAMEGET};
my $transval = KNX_decodeByDpt ($deviceHash, $val, $gadName); my $transval = KNX_decodeByDpt ($deviceHash, $val, $gadName);
#message invalid #message invalid
if (not defined($transval) or ($transval eq q{})) { if (! defined($transval) || ($transval eq q{})) {
Log3 ($deviceName, 2, qq{KNX_Parse ($deviceName): [wp] readingName=$getName message=$msg} . Log3 ($deviceName, 2, qq{KNX_Parse_wp ($deviceName): readingName=$getName message=$msg} .
' could not be decoded'); ' could not be decoded');
next; next;
} }
Log3 ($deviceName, 4, qq{KNX_Parse ($deviceName): [wp] readingName=$getName value=$transval}); Log3 ($deviceName, 4, qq{KNX_Parse_wp ($deviceName): readingName=$getName value=$transval});
#apply post processing for state and set all readings #apply post processing for state and set all readings
KNX_SetReadings($deviceHash, $gadName, $transval, $getName, $src); KNX_SetReadings($deviceHash, $gadName, $transval, $getName, $src);
} }
#handle read messages #handle read messages
elsif ($cmd =~ /[r]/x) { elsif ($cmd =~ /[r]/ix) {
my $putName = $deviceHash->{GADDETAILS}->{$gadName}->{RDNAMEPUT}; my $putName = $deviceHash->{GADDETAILS}->{$gadName}->{RDNAMEPUT};
Log3 ($deviceName, 5, qq{KNX_Parse ($deviceName): [r] GET}); Log3 ($deviceName, 5, qq{KNX_Parse_r ($deviceName): GET});
#answer "old school" #answer "old school"
# my $value = ReadingsVal($deviceName, 'state', undef); # fetch default value from state
my $value = undef; my $value = undef;
if (AttrVal($deviceName, 'answerReading', 0) != 0) { if (AttrVal($deviceName, 'answerReading', 0) != 0) {
my $putVal = ReadingsVal($deviceName, $putName, undef); my $putVal = ReadingsVal($deviceName, $putName, undef);
@ -1076,11 +1081,11 @@ sub KNX_Parse {
if ((defined($cmdAttr)) && ($cmdAttr ne q{})) { if ((defined($cmdAttr)) && ($cmdAttr ne q{})) {
$value = KNX_eval ($deviceHash, $gadName, $value, $cmdAttr); $value = KNX_eval ($deviceHash, $gadName, $value, $cmdAttr);
if (defined($value) && ($value ne q{}) && ($value ne 'ERROR')) { # answer only, if eval was successful if (defined($value) && ($value ne q{}) && ($value ne 'ERROR')) { # answer only, if eval was successful
Log3 ($deviceName, 5, qq{KNX_Parse ($deviceName): [r] replaced by Attr putCmd=$cmdAttr VALUE=$value}); Log3 ($deviceName, 5, qq{KNX_Parse_r ($deviceName): replaced by Attr putCmd=$cmdAttr VALUE=$value});
readingsSingleUpdate($deviceHash, $putName, $value,1); readingsSingleUpdate($deviceHash, $putName, $value,0);
} }
else { else {
Log3 ($deviceName, 5, qq{KNX_Parse ($deviceName): [r] gadName=$gadName - no reply sent!}); Log3 ($deviceName, 5, qq{KNX_Parse_r ($deviceName): gadName=$gadName - no reply sent!});
$value = undef; # dont send ! $value = undef; # dont send !
} }
} }
@ -1088,7 +1093,7 @@ sub KNX_Parse {
#send transval #send transval
if (defined($value)) { if (defined($value)) {
my $transval = KNX_encodeByDpt($deviceHash, $value, $gadName); my $transval = KNX_encodeByDpt($deviceHash, $value, $gadName);
Log3 ($deviceName, 4, qq{KNX_Parse ($deviceName): [r] send answer: reading=$gadName VALUE=$transval}); Log3 ($deviceName, 4, qq{KNX_Parse_r ($deviceName): send answer: reading=$gadName VALUE=$transval});
IOWrite ($deviceHash, $TULid, 'p' . $gadCode . $transval); IOWrite ($deviceHash, $TULid, 'p' . $gadCode . $transval);
} }
} }
@ -1185,6 +1190,7 @@ sub KNX_chkIODev {
push(@IOList2,$iodev); push(@IOList2,$iodev);
next if ($iodev ne $iocandidate); next if ($iodev ne $iocandidate);
return if ($defs{$iodev}->{TYPE} ne 'FHEM2FHEM'); # ok for std io-dev return if ($defs{$iodev}->{TYPE} ne 'FHEM2FHEM'); # ok for std io-dev
# add support for fhem2fhem as io-dev # add support for fhem2fhem as io-dev
my $rawdef = $defs{$iodev}->{rawDevice}; #name of fake local IO-dev or remote IO-dev my $rawdef = $defs{$iodev}->{rawDevice}; #name of fake local IO-dev or remote IO-dev
if (defined($rawdef)) { if (defined($rawdef)) {
@ -1320,8 +1326,7 @@ sub KNX_replaceByRegex {
next if ($rdName ne $regName); # must match completely! next if ($rdName ne $regName); # must match completely!
if (not defined ($regPair[1])) { # cut value if (not defined ($regPair[1])) { # cut value
Log3 ($name, 5, qq{KNX_replaceByRegex ($name): replaced $rdName value from: $input to undefined}); $retVal = 'undefined';
return;
} }
elsif ($regPair[0] eq $tempVal) { # complete match elsif ($regPair[0] eq $tempVal) { # complete match
$retVal = $regPair[1]; $retVal = $regPair[1];
@ -1336,7 +1341,7 @@ sub KNX_replaceByRegex {
last; last;
} }
Log3 ($name, 5, qq{KNX_replaceByRegex ($name): replaced $rdName value from: $input to $retVal}) if ($input ne $retVal); Log3 ($name, 5, qq{KNX_replaceByRegex ($name): replaced $rdName value from: $input to $retVal}) if ($input ne $retVal);
return $retVal; return ($retVal eq 'undefined')?undef:$retVal;
} }
# limit numeric values. Valid directions: encode, decode # limit numeric values. Valid directions: encode, decode
@ -1834,6 +1839,24 @@ sub dec_dpt232 { #RGB-Code
return sprintf ('%.6x',$numval); return sprintf ('%.6x',$numval);
} }
### lookup gadname by gadnumber
### called from: KNX_Get, KNX_setOldsyntax
### entry: $hash, desired gadNO
### return: undef on error / gadName
sub KNX_gadNameByNO {
my $hash = shift;
my $groupnr = shift // 1; # default: seaarch for g1
my $targetGadName = undef;
foreach my $key (keys %{$hash->{GADDETAILS}}) {
if ($hash->{GADDETAILS}->{$key}->{NO} == $groupnr) {
$targetGadName = $key;
last;
}
}
return $targetGadName;
}
########## public utility functions ########## ########## public utility functions ##########
### get state of devices from KNX_Hardware ### get state of devices from KNX_Hardware
@ -1870,17 +1893,15 @@ sub main::KNX_scan {
next if ($iostate ne 'connected'); next if ($iostate ne 'connected');
$i++; $i++;
my $getstring = $devhash->{GETSTRING}; my $k0 = $k; #save previous number of get's
next if ((! defined($getstring)) || $getstring eq q{}); foreach my $key (keys %{$devhash->{GADDETAILS}}) {
$j++; last if (! defined($key));
my @getnames = split(/\s/ix,$getstring); my $option = $devhash->{GADDETAILS}->{$key}->{OPTION};
next if (defined($option) && $option =~ /(?:set|listenonly)/ix);
foreach my $gads (@getnames) {
my $gad = (split(/[:]/ix,$gads))[0];
$k++; $k++;
Log3 ($knxdef, 4, qq{KNX_scan-exec: [$k] CMD= "get $knxdef $gad"}); $getsarr .= $knxdef . q{ } . $key . q{,};
$getsarr .= $knxdef . q{ } . $gad . q{,};
} }
$j++ if ($k > $k0);
} }
Log3 (undef, 3, qq{KNX_scan: $i devices selected / $j devices with get / $k "gets" executing...}); Log3 (undef, 3, qq{KNX_scan: $i devices selected / $j devices with get / $k "gets" executing...});
doKNX_scan($getsarr) if ($k > 0); doKNX_scan($getsarr) if ($k > 0);
@ -2070,7 +2091,7 @@ The answer from the bus-device updates the readings &lt;getName&gt; and state.</
<a href="#verbose">verbose</a><br /> <a href="#verbose">verbose</a><br />
<a href="#FHEMWEB-attr-webCmd">webCmd</a><br /> <a href="#FHEMWEB-attr-webCmd">webCmd</a><br />
<a href="#FHEMWEB-attr-webCmdLabel">webCmdLabel</a><br /> <a href="#FHEMWEB-attr-webCmdLabel">webCmdLabel</a><br />
<a href="#FHEMWEB-attr-widgetOverride">widgetOverride</a> <a href="#KNX-attr-widgetOverride">widgetOverride</a>
</ol> </ol>
<p><strong>Special attributes</strong></p> <p><strong>Special attributes</strong></p>
@ -2122,6 +2143,11 @@ The answer from the bus-device updates the readings &lt;getName&gt; and state.</
except in cases where multiple IO-devices (of type TUL/KNXTUL/KNXIO) exist in your config. Defining more than one IO-device is <b>NOT recommended</b> except in cases where multiple IO-devices (of type TUL/KNXTUL/KNXIO) exist in your config. Defining more than one IO-device is <b>NOT recommended</b>
unless you take special care with yr. knxd or KNX-router definitions - to prevent multiple path from KNX-Bus to FHEM resulting in message loops.</li> unless you take special care with yr. knxd or KNX-router definitions - to prevent multiple path from KNX-Bus to FHEM resulting in message loops.</li>
<br/> <br/>
<a id="KNX-attr-widgetOverride"></a><li>widgetOverride<br/>
This is a standard FHEMWEB-attribute, the recommendation for use in KNX-module is to specify the following form:
<b>&lt;gadName&gt;@set&colon;&lt;widgetName,parameter&gt;</b> This avoids overwriting the GET pulldown in FHEMWEB detail page.
For details, pls see <a href="#FHEMWEB-attr-widgetOverride">FHEMWEB-attribute</a>.</li>
<br/>
<a id="KNX-attr-listenonly"></a><li>listenonly - This attr is deprecated - use "listenonly" option in device definition</li> <a id="KNX-attr-listenonly"></a><li>listenonly - This attr is deprecated - use "listenonly" option in device definition</li>
<a id="KNX-attr-readonly"></a><li>readonly - This attr is deprecated - use "get" option in device definition</li> <a id="KNX-attr-readonly"></a><li>readonly - This attr is deprecated - use "get" option in device definition</li>
<a id="KNX-attr-slider"></a><li>slider - This attr is deprecated - use attribute widgetOverride &lt;gadName&gt;:slider,&lt;start-&gt;,&lt;step-&gt;,&lt;end-range&gt; instead</li> <a id="KNX-attr-slider"></a><li>slider - This attr is deprecated - use attribute widgetOverride &lt;gadName&gt;:slider,&lt;start-&gt;,&lt;step-&gt;,&lt;end-range&gt; instead</li>