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

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

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@27101 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
erwin 2023-01-22 15:10:21 +00:00
parent 2aa0a89263
commit 12610179bd
2 changed files with 159 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
fhem/FHEM/00_KNXIO.pm
View File

@ -42,6 +42,7 @@
# 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 # 19/12/2022 cleanup
# xx/01/2023 cleanup, simplify _openDev
package KNXIO; ## no critic 'package' package KNXIO; ## no critic 'package'
@ -199,7 +200,9 @@ sub KNXIO_Define {
Log3 ($name, 3, qq{KNXIO_define ($name): opening device mode=$mode}); Log3 ($name, 3, qq{KNXIO_define ($name): opening device mode=$mode});
return InternalTimer(gettimeofday() + 0.2,\&KNXIO_openDev,$hash); # return InternalTimer(gettimeofday() + 0.2,\&KNXIO_openDev,$hash);
return InternalTimer(gettimeofday() + 0.2,\&KNXIO_openDev,$hash) if (! $init_done);
return KNXIO_openDev($hash);
} }
##################################### #####################################
@ -423,8 +426,9 @@ 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.
# DoTrigger($name, 'CONNECTED');
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
$hash->{KNXIOhelper}->{SEQUENCECNTR} = 0; $hash->{KNXIOhelper}->{SEQUENCECNTR} = 0;
} }
@ -648,7 +652,7 @@ sub KNXIO_openDev {
return; return;
} }
readingsSingleUpdate($hash, 'state', 'disconnected', 1); readingsSingleUpdate($hash, 'state', 'disconnected', 1);
return; return qq{KNXIO_openDev ($name): open failed};
} }
if (exists $hash->{DNSWAIT}) { if (exists $hash->{DNSWAIT}) {
@ -663,8 +667,9 @@ sub KNXIO_openDev {
} }
return if (! exists($hash->{DeviceName})); # DNS failed ! return if (! exists($hash->{DeviceName})); # DNS failed !
my $reopen = (exists($hash->{NEXT_OPEN}))?1:0; # my $reopen = (exists($hash->{NEXT_OPEN}))?1:0;
my $param = $hash->{DeviceName}; # (connection-code):ip:port or socket param my $param = $hash->{DeviceName}; # ip:port or UNIX:STREAM:<socket param>
=pod
my ($ccode, $host, $port) = split(/[:]/ix,$param); my ($ccode, $host, $port) = split(/[:]/ix,$param);
if (! defined($port)) { if (! defined($port)) {
$port = $host; $port = $host;
@ -672,6 +677,8 @@ sub KNXIO_openDev {
$ccode = undef; $ccode = undef;
} }
$host = $port if ($param =~ /UNIX:STREAM:/ix); $host = $port if ($param =~ /UNIX:STREAM:/ix);
=cut
my ($host, $port) = split(/[:]/ix,$param);
Log3 ($name, 5, qq{KNXIO_openDev ($name): $mode , $host , $port , reopen= $reopen}); Log3 ($name, 5, qq{KNXIO_openDev ($name): $mode , $host , $port , reopen= $reopen});
@ -682,13 +689,13 @@ sub KNXIO_openDev {
delete $hash->{TCPDev}; # devio ? delete $hash->{TCPDev}; # devio ?
$ret = TcpServer_Open($hash, $port, $host, 1); $ret = TcpServer_Open($hash, $port, $host, 1);
if (defined($ret)) { # error if (defined($ret)) { # error
Log3 ($name, 2, qq{KNXIO_openDev ($name): " can't connect: " $ret}) if(!$reopen); Log3 ($name, 2, qq{KNXIO_openDev ($name): can't connect: $ret}) if(!$reopen);
return; return qq{KNXIO_openDev ($name): can't connect: $ret};
} }
$ret = TcpServer_MCastAdd($hash,$host); $ret = TcpServer_MCastAdd($hash,$host);
if (defined($ret)) { # error if (defined($ret)) { # error
Log3 ($name, 2, qq{KNXIO_openDev ($name): MC add failed: $ret}) if(!$reopen); Log3 ($name, 2, qq{KNXIO_openDev ($name): MC add failed: $ret}) if(!$reopen);
return; return qq{KNXIO_openDev ($name): MC add failed: $ret};
} }
TcpServer_SetLoopbackMode($hash,0); # disable loopback TcpServer_SetLoopbackMode($hash,0); # disable loopback
@ -700,9 +707,10 @@ sub KNXIO_openDev {
### socket mode ### socket mode
elsif ($mode eq 'S') { elsif ($mode eq 'S') {
$host = (split(/[:]/ix,$param))[2]; # UNIX:STREAM:<socket path>
if (!(-S -r -w $host) && $init_done) { if (!(-S -r -w $host) && $init_done) {
Log3 ($name, 2, q{KNXIO_openDev ($name): Socket not available - (knxd running?)}); Log3 ($name, 2, q{KNXIO_openDev ($name): Socket not available - (knxd running?)});
return; return qq{KNXIO_openDev ($name): Socket not available - (knxd running?)};
} }
$ret = DevIo_OpenDev($hash,$reopen,\&KNXIO_init); # no callback $ret = DevIo_OpenDev($hash,$reopen,\&KNXIO_init); # no callback
} }
@ -712,7 +720,7 @@ sub KNXIO_openDev {
my $conn = 0; my $conn = 0;
$conn = IO::Socket::INET->new(PeerAddr => "$host:$port", Type => SOCK_DGRAM, Proto => 'udp', Reuse => 1); $conn = IO::Socket::INET->new(PeerAddr => "$host:$port", Type => SOCK_DGRAM, Proto => 'udp', Reuse => 1);
if (!($conn)) { if (!($conn)) {
Log3 ($name, 2, qq{KNXIO_openDev ($name): " can't connect: " $ERRNO}) if(!$reopen); Log3 ($name, 2, qq{KNXIO_openDev ($name): can't connect: $ERRNO}) if(!$reopen);
$readyfnlist{"$name.$param"} = $hash; $readyfnlist{"$name.$param"} = $hash;
readingsSingleUpdate($hash, 'state', 'disconnected', 1); readingsSingleUpdate($hash, 'state', 'disconnected', 1);
$hash->{NEXT_OPEN} = gettimeofday() + $reconnectTO; $hash->{NEXT_OPEN} = gettimeofday() + $reconnectTO;
@ -762,10 +770,9 @@ sub KNXIO_init {
# state 'connected' is set in decode_EMI (model ST) or in readH (model H) # state 'connected' is set in decode_EMI (model ST) or in readH (model H)
else { else {
# DoTrigger($name, 'CONNECTED'); # DoTrigger($name, 'CONNECTED');
readingsSingleUpdate($hash, 'state', 'connected', 1); readingsSingleUpdate($hash, 'state', 'connected', 1);
Log3 ($name, 3, qq{KNXIO ($name) connected}); Log3 ($name, 3, qq{KNXIO $name connected});
} }
return; return;
@ -895,7 +902,7 @@ sub KNXIO_closeDev {
my $param = $hash->{DeviceName}; my $param = $hash->{DeviceName};
if ($hash->{model} eq 'M') { if ($hash->{model} eq 'M') {
TcpServer_Close($hash); TcpServer_Close($hash,0);
} }
else { else {
DevIo_CloseDev($hash); DevIo_CloseDev($hash);
@ -942,8 +949,9 @@ sub KNXIO_decodeEMI {
if ($id != 0x0027) { if ($id != 0x0027) {
if ($id == 0x0026) { if ($id == 0x0026) {
Log3 ($name, 4, 'KNXIO_decodeEMI: OpenGrpCon response received'); Log3 ($name, 4, 'KNXIO_decodeEMI: OpenGrpCon response received');
# DoTrigger($name, 'CONNECTED');
readingsSingleUpdate($hash, 'state', 'connected', 1); readingsSingleUpdate($hash, 'state', 'connected', 1);
Log3 ($name, 3, qq{KNXIO ($name) connected}); Log3 ($name, 3, qq{KNXIO $name connected});
} }
else { else {
Log3 ($name, 3, 'KNXIO_decodeEMI: invalid message code ' . sprintf('%04x',$id)); Log3 ($name, 3, 'KNXIO_decodeEMI: invalid message code ' . sprintf('%04x',$id));

212
fhem/FHEM/10_KNX.pm
View File

@ -108,8 +108,13 @@
# changed not user relevant internals to {.XXXX} # changed not user relevant internals to {.XXXX}
# changed DbLog_split function # changed DbLog_split function
# disabled StateFn # disabled StateFn
# MH 202301xx change pattern matching for dpt1 and dptxxx # MH 20230104 change pattern matching for dpt1 and dptxxx
# fix DbLogSplitFn # fix DbLogSplitFn
# MH 20230124 simplify DbLogSplitFn
# modify parsing of gadargs in define
# modify KNX_parse - reply msg code
# modify KNX_set
# add pulldown menu for attr IODev with vaild IO-devs
package KNX; ## no critic 'package' package KNX; ## no critic 'package'
@ -457,7 +462,6 @@ sub KNX_Define {
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... $hash->{'.DEFLINE'} = join(q{ },@a); # temp store defs for define2...
return InternalTimer(gettimeofday() + 5.0,\&KNX_Define2,$hash) if (! $init_done); return InternalTimer(gettimeofday() + 5.0,\&KNX_Define2,$hash) if (! $init_done);
return KNX_Define2($hash); return KNX_Define2($hash);
@ -474,7 +478,12 @@ sub KNX_Define2 {
RemoveInternalTimer($hash); RemoveInternalTimer($hash);
my $logtxt = qq{KNX_define2 ($name): }; # leading txt my $logtxt = qq{KNX_define2 ($name): }; # leading txt
### end new
# Add pulldown for attr IODev
my $attrList = $modules{KNX}->{AttrList}; #get Attrlist from Module def
my $IODevs = KNX_chkIODev($hash); # get list of valid IO's
$attrList =~ s/\bIODev\b([:]select[^\s]*)?/IODev:select,$IODevs/x;
$modules{KNX}->{AttrList} = $attrList;
AssignIoPort($hash); # AssignIoPort will take device from $attr{$name}{IODev} if defined AssignIoPort($hash); # AssignIoPort will take device from $attr{$name}{IODev} if defined
@ -518,6 +527,7 @@ sub KNX_Define2 {
$hash->{model} = lc($gadModel) =~ s/^(dpt[\d]+)\..*/$1/rx; # use first gad as mdl reference for fheminfo $hash->{model} = lc($gadModel) =~ s/^(dpt[\d]+)\..*/$1/rx; # use first gad as mdl reference for fheminfo
} }
=pod
if (@gadArgs) { if (@gadArgs) {
if ($gadArgs[0] =~ m/^($PAT_GAD_OPTIONS|$PAT_GAD_SUFFIX)$/ix) { # no gadname given if ($gadArgs[0] =~ m/^($PAT_GAD_OPTIONS|$PAT_GAD_SUFFIX)$/ix) { # no gadname given
unshift ( @gadArgs , 'dummy' ); # shift option up in array unshift ( @gadArgs , 'dummy' ); # shift option up in array
@ -531,6 +541,13 @@ sub KNX_Define2 {
$gadOption = $gadArgs[1] if(defined($gadArgs[1]) && $gadArgs[1] =~ m/($PAT_GAD_OPTIONS)/ix); $gadOption = $gadArgs[1] if(defined($gadArgs[1]) && $gadArgs[1] =~ m/($PAT_GAD_OPTIONS)/ix);
$gadNoSuffix = $PAT_GAD_SUFFIX if (join(q{ },@gadArgs) =~ m/($PAT_GAD_SUFFIX)/ix); $gadNoSuffix = $PAT_GAD_SUFFIX if (join(q{ },@gadArgs) =~ m/($PAT_GAD_SUFFIX)/ix);
=cut
if (scalar(@gadArgs)) {
$gadNoSuffix = pop(@gadArgs) if ($gadArgs[-1] =~ /$PAT_GAD_SUFFIX/ix);
$gadOption = pop(@gadArgs) if (@gadArgs && $gadArgs[-1] =~ /($PAT_GAD_OPTIONS)$/ix);
$gadName = pop(@gadArgs) if (@gadArgs);
return $logtxt . qq{forbidden gad-name: $gadName} if ($gadName =~ /$PAT_GAD_NONAME$/ix);
return ($logtxt . qq{invalid option for group-number $gadNo. Use one of: $PAT_GAD_OPTIONS}) if (defined($gadOption) && ($gadOption !~ m/^(?:$PAT_GAD_OPTIONS)$/ix)); return ($logtxt . qq{invalid option for group-number $gadNo. Use one of: $PAT_GAD_OPTIONS}) if (defined($gadOption) && ($gadOption !~ m/^(?:$PAT_GAD_OPTIONS)$/ix));
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));
} }
@ -677,7 +694,8 @@ sub KNX_Get {
IOWrite($hash, $TULid, 'r' . $groupc); #send read-request to the bus IOWrite($hash, $TULid, 'r' . $groupc); #send read-request to the bus
FW_directNotify('FILTER=' . $FW_detail, '#FHEMWEB:' . $FW_wname, 'FW_errmsg(" current value for ' . $name . ' - ' . $group . ' requested",5000)', qq{}) if (defined($FW_wname)); FW_directNotify('#FHEMWEB:' . $FW_wname, 'FW_errmsg(" value for ' . $name . ' - ' . $group . ' requested",5000)', qq{}) if (defined($FW_wname));
# FW_directNotify('FILTER=' . $FW_detail, '#FHEMWEB:' . $FW_wname, 'FW_errmsg(" current value for ' . $name . ' - ' . $group . ' requested",5000)', qq{}) if (defined($FW_wname));
return; return;
} }
@ -685,28 +703,30 @@ sub KNX_Get {
#Does something according the given cmd... #Does something according the given cmd...
############################# #############################
sub KNX_Set { sub KNX_Set {
my ($hash, $name, $cmd, @arg) = @_; my ($hash, $name, $targetGadName, @arg) = @_;
my @ca = caller(0); #identify this sub my @ca = caller(0); #identify this sub
my $thisSub = $ca[3] =~ s/.+[:]+//grx; my $thisSub = $ca[3] =~ s/.+[:]+//grx;
$thisSub .= qq{ ($name): }; $thisSub .= qq{ ($name): };
#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($targetGadName) && ($targetGadName =~ m/\?/x)) {
my $setter = exists($hash->{'.SETSTRING'})?$hash->{'.SETSTRING'}:q{}; my $setter = exists($hash->{'.SETSTRING'})?$hash->{'.SETSTRING'}:q{};
$setter = q{} if (IsDisabled($name) == 1); $setter = q{} if (IsDisabled($name) == 1);
return qq{unknown argument $cmd choose one of $setter}; return qq{unknown argument $targetGadName choose one of $setter};
} }
return $thisSub . 'is disabled' if (IsDisabled($name) == 1); return $thisSub . 'is disabled' if (IsDisabled($name) == 1);
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($targetGadName)) || ($targetGadName eq q{})); #return, if no cmd specified
Log3 ($name, 5, $thisSub . qq{-enter: $cmd } . join(q{ }, @arg)); Log3 ($name, 5, $thisSub . qq{-enter: $targetGadName } . join(q{ }, @arg));
my $targetGadName = $cmd =~ s/^\s+|\s+$//girx; # gad-name or cmd (in old syntax) $targetGadName =~ s/^\s+|\s+$//gx; # gad-name or cmd (in old syntax)
# my $targetGadName = $cmd =~ s/^\s+|\s+$//girx; # gad-name or cmd (in old syntax)
my $cmd = undef;
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
$cmd = shift(@arg); #shift backup args as with newsyntax $a[2] is cmd $cmd = shift(@arg); #shift args as with newsyntax $arg[0] is cmd
return $thisSub . 'no cmd found' if(!defined($cmd)); return $thisSub . 'no cmd found' if(!defined($cmd));
} }
else { else {
@ -726,7 +746,7 @@ sub KNX_Set {
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) && (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) {
@ -758,16 +778,17 @@ sub KNX_Set {
# calling param: $hash, $cmd, arg array # calling param: $hash, $cmd, arg array
# returns ($err, targetgadname, $cmd) # returns ($err, targetgadname, $cmd)
sub KNX_Set_oldsyntax { sub KNX_Set_oldsyntax {
my ($hash, $cmd, @a) = @_; my ($hash, $cmd, @arg) = @_;
my $name = $hash->{NAME};
my $na = scalar(@a); my $name = $hash->{NAME};
my $na = scalar(@arg);
my $targetGadName = undef; #contains gadNames to process my $targetGadName = undef; #contains gadNames to process
my $groupnr = 1; #default group my $groupnr = 1; #default group
#select another group, if the last arg starts with a g #select another group, if the last arg starts with a g
if($na >= 1 && $a[$na - 1] =~ m/$PAT_GNO/ix) { if($na >= 1 && $arg[$na - 1] =~ m/$PAT_GNO/ix) {
$groupnr = pop (@a); $groupnr = pop (@arg);
Log3 ($name, 3, qq{KNX_Set_syntax2 ($name): you are still using old syntax, pls. change to "set $name $groupnr $cmd } . join(q{ },@a) . q{"}); Log3 ($name, 3, qq{KNX_Set_syntax2 ($name): you are still using old syntax, pls. change to "set $name $groupnr $cmd } . join(q{ },@arg) . q{"});
$groupnr =~ s/^g//gix; #remove "g" $groupnr =~ s/^g//gix; #remove "g"
} }
@ -782,19 +803,19 @@ sub KNX_Set_oldsyntax {
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)
return (undef, $targetGadName, $cmd) if (scalar(@a) <= 0); return (undef, $targetGadName, $cmd) if (scalar(@arg) <= 0);
my $code = $hash->{GADDETAILS}->{$targetGadName}->{MODEL}; my $code = $hash->{GADDETAILS}->{$targetGadName}->{MODEL};
my $value = $cmd; my $value = $cmd;
if ($cmd =~ m/$RAW/ix) { if ($cmd =~ m/$RAW/ix) {
#check for 1-16 hex-digits #check for 1-16 hex-digits
return q{"raw" } . $a[0] . ' has wrong syntax. Use hex-format only.' if ($a[0] !~ m/[0-9A-F]{1,16}/ix); return q{"raw" } . $arg[0] . ' has wrong syntax. Use hex-format only.' if ($arg[0] !~ m/[0-9A-F]{1,16}/ix);
$value = $a[0]; $value = $arg[0];
} }
elsif ($cmd =~ m/$VALUE/ix) { elsif ($cmd =~ m/$VALUE/ix) {
return q{"value" not allowed for dpt1, dpt16 and dpt232} if ($code =~ m/(dpt1$)|(dpt16$)|(dpt232$)/ix); return q{"value" not allowed for dpt1, dpt16 and dpt232} if ($code =~ m/(dpt1$)|(dpt16$)|(dpt232$)/ix);
$value = $a[0]; $value = $arg[0];
$value =~ s/,/\./gx; $value =~ s/,/\./gx;
} }
#set string <val1 val2 valn> #set string <val1 val2 valn>
@ -806,8 +827,8 @@ sub KNX_Set_oldsyntax {
elsif ($cmd =~ m/$RGB/ix) { elsif ($cmd =~ m/$RGB/ix) {
return q{"rgb" only allowed for dpt232} if ($code !~ m/dpt232$/ix); return q{"rgb" only allowed for dpt232} if ($code !~ m/dpt232$/ix);
#check for 6 hex-digits #check for 6 hex-digits
return q{"rgb" } . $a[0] . q{ has wrong syntax. Use 6 hex-digits only.} if ($a[0] !~ m/[0-9A-F]{6}/ix); return q{"rgb" } . $arg[0] . q{ has wrong syntax. Use 6 hex-digits only.} if ($arg[0] !~ m/[0-9A-F]{6}/ix);
$value = lc($a[0]); $value = lc($arg[0]);
} }
return (undef, $targetGadName, $value); return (undef, $targetGadName, $value);
@ -818,6 +839,7 @@ sub KNX_Set_oldsyntax {
# return: $err, $value # return: $err, $value
sub KNX_Set_dpt1 { sub KNX_Set_dpt1 {
my ($hash, $targetGadName, $cmd, @arg) = @_; my ($hash, $targetGadName, $cmd, @arg) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $groupCode = $hash->{GADDETAILS}->{$targetGadName}->{CODE}; my $groupCode = $hash->{GADDETAILS}->{$targetGadName}->{CODE};
@ -926,9 +948,10 @@ sub KNX_State {
############################# #############################
sub KNX_Attr { sub KNX_Attr {
my ($cmd,$name,$aName,$aVal) = @_; my ($cmd,$name,$aName,$aVal) = @_;
my $hash = $defs{$name};
my $hash = $defs{$name};
my $value = undef; my $value = undef;
if ($cmd eq 'set') { if ($cmd eq 'set') {
return qq{KNX_Attr ($name): Attribute "$aName" is not supported/have no function at all, pls. check cmdref for equivalent function.} if ($aName =~ m/(listenonly|readonly|slider)/ix); return qq{KNX_Attr ($name): Attribute "$aName" is not supported/have no function at all, pls. check cmdref for equivalent function.} if ($aName =~ m/(listenonly|readonly|slider)/ix);
@ -983,10 +1006,21 @@ sub KNX_Attr {
#Split reading for DBLOG #Split reading for DBLOG
############################# #############################
sub KNX_DbLog_split { sub KNX_DbLog_split {
my ($event, $device) = @_; # my ($event, $device) = @_;
my $event = shift;
my $device = shift;
my $reading = 'state'; # default
my $unit = q{}; # default my $unit = q{}; # default
# split event into pieces
$event =~ s/^\s?//x; # remove leading blank if any
my @strings = split (/[\s]+/x, $event);
if ($strings[0] =~ /.+[:]$/x) {
$reading = shift(@strings);
$reading =~ s/[:]$//x;
}
=pod
# split event into reading & value # split event into reading & value
my ($reading,$value) = ($event =~ /^([^\s]+)[:]\s(.*)/x ); my ($reading,$value) = ($event =~ /^([^\s]+)[:]\s(.*)/x );
# my ($reading, $value) = split(/:\s/x, $event, 2); # my ($reading, $value) = split(/:\s/x, $event, 2);
@ -997,13 +1031,16 @@ sub KNX_DbLog_split {
# split value # split value
my @strings = split(/\s/x, $value); my @strings = split(/\s/x, $value);
=cut
$strings[0] = q{} if (! defined($strings[0])); $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)]); $unit = pop(@strings);
$unit = $strings[scalar(@strings)-1]; # $value = join(q{ },@strings[0 .. (scalar(@strings)-2)]);
# $unit = $strings[scalar(@strings)-1];
} }
my $value = join(q{ },@strings);
$unit = q{} if (!defined($unit)); $unit = q{} if (!defined($unit));
Log3 ($device, 5, qq{KNX_DbLog_Split ($device): EVENT= $event READING= $reading VALUE= $value UNIT= $unit}); Log3 ($device, 5, qq{KNX_DbLog_Split ($device): EVENT= $event READING= $reading VALUE= $value UNIT= $unit});
@ -1069,8 +1106,9 @@ sub KNX_Parse {
my $putName = $deviceHash->{GADDETAILS}->{$gadName}->{RDNAMEPUT}; my $putName = $deviceHash->{GADDETAILS}->{$gadName}->{RDNAMEPUT};
Log3 ($deviceName, 5, qq{KNX_Parse_r ($deviceName): GET}); Log3 ($deviceName, 5, qq{KNX_Parse_r ($deviceName): GET});
#answer "old school" # #answer "old school"
my $value = undef; my $value = undef;
=pod
if (AttrVal($deviceName, 'answerReading', 0) != 0) { if (AttrVal($deviceName, 'answerReading', 0) != 0) {
my $putVal = ReadingsVal($deviceName, $putName, undef); my $putVal = ReadingsVal($deviceName, $putName, undef);
if (defined($putVal) && ($putVal ne q{})) { if (defined($putVal) && ($putVal ne q{})) {
@ -1080,7 +1118,7 @@ sub KNX_Parse {
$value = ReadingsVal($deviceName, 'state', undef); #lowest priority - use state! $value = ReadingsVal($deviceName, 'state', undef); #lowest priority - use state!
} }
} }
=cut
#high priority - eval #high priority - eval
my $cmdAttr = AttrVal($deviceName, 'putCmd', undef); my $cmdAttr = AttrVal($deviceName, 'putCmd', undef);
if ((defined($cmdAttr)) && ($cmdAttr ne q{})) { if ((defined($cmdAttr)) && ($cmdAttr ne q{})) {
@ -1094,6 +1132,16 @@ sub KNX_Parse {
$value = undef; # dont send ! $value = undef; # dont send !
} }
} }
# medium / low priority
elsif (AttrVal($deviceName, 'answerReading', 0) != 0) {
my $putVal = ReadingsVal($deviceName, $putName, undef);
if (defined($putVal) && ($putVal ne q{})) {
$value = $putVal; #medium priority, overwrite $value
}
else {
$value = ReadingsVal($deviceName, 'state', undef); #lowest priority - use state!
}
}
#send transval #send transval
if (defined($value)) { if (defined($value)) {
@ -1109,7 +1157,7 @@ sub KNX_Parse {
########## begin of private functions ########## ########## begin of private functions ##########
# KNX_autoCreate ### KNX_autoCreate
# check wether we must do autocreate... # check wether we must do autocreate...
# on entry: $iohash, $gadcode # on entry: $iohash, $gadcode
# on exit: return string for autocreate # on exit: return string for autocreate
@ -1131,7 +1179,7 @@ sub KNX_autoCreate {
return qq{UNDEFINED $newDevName KNX $gad} . q{:} . $MODELERR; return qq{UNDEFINED $newDevName KNX $gad} . q{:} . $MODELERR;
} }
# KNX_SetReadings is called from KNX_Set and KNX_Parse ### KNX_SetReadings is called from KNX_Set and KNX_Parse
# calling param: $hash, $gadName, $transval, $rdName, caller (set/parse) # calling param: $hash, $gadName, $transval, $rdName, caller (set/parse)
sub KNX_SetReadings { sub KNX_SetReadings {
my ($hash, $gadName, $transval, $rdName, $src) = @_; my ($hash, $gadName, $transval, $rdName, $src) = @_;
@ -1179,12 +1227,14 @@ sub KNX_SetReadings {
return; return;
} }
#check for valid IODev ### check for valid IODev
#called from define & Attr # called from define & Attr
# returns undef on success , error msg on failure # returns undef on success , error msg on failure
# returns list of IODevs if $iocandidate is undef on entry
sub KNX_chkIODev { sub KNX_chkIODev {
my $hash = shift; my $hash = shift;
my $iocandidate = shift; my $iocandidate = shift // 'undefined';
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my @IOList = devspec2array('TYPE=(TUL|KNXTUL|KNXIO|FHEM2FHEM)'); my @IOList = devspec2array('TYPE=(TUL|KNXTUL|KNXIO|FHEM2FHEM)');
@ -1192,22 +1242,25 @@ sub KNX_chkIODev {
foreach my $iodev (@IOList) { foreach my $iodev (@IOList) {
next unless $iodev; next unless $iodev;
next if ((IsDisabled($iodev) == 1) || IsDummy($iodev)); # IO - device is disabled or dummy next if ((IsDisabled($iodev) == 1) || IsDummy($iodev)); # IO - device is disabled or dummy
my $iohash = $defs{$iodev};
next if ($iohash->{TYPE} eq 'KNXIO' && exists($iohash->{model}) && $iohash->{model} eq 'X'); # exclude dummy dev
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 ($iohash->{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 = $iohash->{rawDevice}; #name of fake local IO-dev or remote IO-dev
if (defined($rawdef)) { 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($defs{$rawdef}) && $defs{$rawdef}->{TYPE} eq 'KNXIO' && $defs{$rawdef}->{model} eq 'X'); # only if model of fake device eq 'X'
return if (exists($defs{$iodev}->{'.RTYPE'}) && $defs{$iodev}->{'.RTYPE'} eq 'KNXIO'); # remote TYPE is KNXIO ( need patched FHEM2FHEM module) return if (exists($iohash->{'.RTYPE'}) && $iohash->{'.RTYPE'} eq 'KNXIO'); # remote TYPE is KNXIO ( need patched FHEM2FHEM module)
} }
} }
return join(q{,}, @IOList2) if ($iocandidate eq 'undefined');
return $iocandidate . ' is not a valid IO-device or disabled/dummy for ' . qq{$name \n} . return $iocandidate . ' is not a valid IO-device or disabled/dummy for ' . qq{$name \n} .
'Valid IO-devices are: ' . join(q{, }, @IOList2); 'Valid IO-devices are: ' . join(q{, }, @IOList2);
} }
# delete all defptr entries for this device ### delete all defptr entries for this device
# used in undefine & define (avoid defmod problem) 09-02-2021 # used in undefine & define (avoid defmod problem) 09-02-2021
# calling param: $hash # calling param: $hash
# return param: none # return param: none
@ -1233,7 +1286,7 @@ sub KNX_delete_defptr {
return; return;
} }
# convert GAD from hex to readable version ### convert GAD from hex to readable version
sub KNX_hexToName { sub KNX_hexToName {
my $v = shift; my $v = shift;
@ -1244,14 +1297,14 @@ sub KNX_hexToName {
return sprintf('%d/%d/%d', $p1,$p2,$p3); return sprintf('%d/%d/%d', $p1,$p2,$p3);
} }
# convert PHY from hex to readable version ### convert PHY from hex to readable version
sub KNX_hexToName2 { sub KNX_hexToName2 {
my $v = KNX_hexToName(shift); my $v = KNX_hexToName(shift);
$v =~ s/\//\./gx; $v =~ s/\//\./gx;
return $v; return $v;
} }
# convert GAD from readable version to hex ### convert GAD from readable version to hex
sub KNX_nameToHex { sub KNX_nameToHex {
my $v = shift; my $v = shift;
my $r = $v; my $r = $v;
@ -1262,7 +1315,8 @@ sub KNX_nameToHex {
return $r; return $r;
} }
# clean input string according DPT ### clean input string according DPT
# return undef on error
sub KNX_checkAndClean { sub KNX_checkAndClean {
my ($hash, $value, $gadName) = @_; my ($hash, $value, $gadName) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@ -1302,7 +1356,7 @@ sub KNX_checkAndClean {
return $value; return $value;
} }
# replace state-values by Attr stateRegex ### replace state-values by Attr stateRegex
sub KNX_replaceByRegex { sub KNX_replaceByRegex {
my ($hash, $rdName, $input) = @_; my ($hash, $rdName, $input) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@ -1349,7 +1403,9 @@ sub KNX_replaceByRegex {
return ($retVal eq 'undefined')?undef:$retVal; return ($retVal eq 'undefined')?undef:$retVal;
} }
# limit numeric values. Valid directions: encode, decode ### limit numeric values. Valid directions: encode, decode
# called from: _encodeByDpt, _decodeByDpt
# returns: limited value
sub KNX_limit { sub KNX_limit {
my ($hash, $value, $model, $direction) = @_; my ($hash, $value, $model, $direction) = @_;
@ -1390,7 +1446,7 @@ sub KNX_limit {
return $retVal; return $retVal;
} }
# process attributes stateCmd & putCmd ### process attributes stateCmd & putCmd
sub KNX_eval { sub KNX_eval {
my ($hash, $gadName, $state, $evalString) = @_; my ($hash, $gadName, $state, $evalString) = @_;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@ -1407,28 +1463,31 @@ sub KNX_eval {
return $retVal; return $retVal;
} }
# encode KNX-Message according DPT ### encode KNX-Message according DPT
# on return: hex string to be sent to bus / undef on error
sub KNX_encodeByDpt { sub KNX_encodeByDpt {
my ($hash, $value, $gadName) = @_; # my ($hash, $value, $gadName) = @_;
my $name = $hash->{NAME}; my $hash = shift;
my $value = shift;
my $gadName = shift;
my $name = $hash->{NAME};
my $model = $hash->{GADDETAILS}->{$gadName}->{MODEL}; my $model = $hash->{GADDETAILS}->{$gadName}->{MODEL};
my $code = $dpttypes{$model}->{CODE}; my $code = $dpttypes{$model}->{CODE};
#return unchecked, if this is a autocreate-device return if ($model eq $MODELERR); #return unchecked, if this is a autocreate-device
return if ($model eq $MODELERR);
#this one stores the translated hex-value #this one stores the translated hex-value
my $hexval = undef; # my $hexval = undef;
my $ivalue = $value; # save for compare # my $ivalue = $value; # save for compare
$value = KNX_limit ($hash, $value, $model, 'ENCODE'); my $lvalue = KNX_limit ($hash, $value, $model, 'ENCODE');
Log3 ($name, 4, qq{KNX_limit ($name): gadName= $gadName modified... Input= $ivalue Output= $value Model= $model}) if ($ivalue ne $value); Log3 ($name, 4, qq{KNX_limit ($name): gadName= $gadName modified... Input= $value Output= $lvalue Model= $model}) if ($value ne $lvalue);
if (ref($dpttypes{$code}->{ENC}) eq 'CODE') { if (ref($dpttypes{$code}->{ENC}) eq 'CODE') {
$hexval = $dpttypes{$code}->{ENC}->($value, $model); my $hexval = $dpttypes{$code}->{ENC}->($lvalue, $model);
Log3 ($name, 5, qq{KNX_encodeByDpt ($name): gadName= $gadName model= $model code= $code } . Log3 ($name, 5, qq{KNX_encodeByDpt ($name): gadName= $gadName model= $model code= $code } .
qq{in-Value= $ivalue out-value= $value out-hexval= $hexval}); qq{in-Value= $value out-value= $lvalue out-hexval= $hexval});
return $hexval; return $hexval;
} }
else { else {
@ -1437,23 +1496,22 @@ sub KNX_encodeByDpt {
return; return;
} }
# decode KNX-Message according DPT ### decode KNX-Message according DPT
# on return: decoded value from bus / on error: undef
sub KNX_decodeByDpt { sub KNX_decodeByDpt {
my ($hash, $value, $gadName) = @_; # my ($hash, $value, $gadName) = @_;
my $name = $hash->{NAME}; my $hash = shift;
my $value = shift;
my $gadName = shift;
#get model my $name = $hash->{NAME};
my $model = $hash->{GADDETAILS}->{$gadName}->{MODEL}; my $model = $hash->{GADDETAILS}->{$gadName}->{MODEL};
my $code = $dpttypes{$model}->{CODE}; my $code = $dpttypes{$model}->{CODE};
#return unchecked, if this is a autocreate-device return if ($model eq $MODELERR); #return unchecked, if this is a autocreate-device
return if ($model eq $MODELERR);
#this one contains the return-value
my $state = undef;
if (ref($dpttypes{$code}->{DEC}) eq 'CODE') { if (ref($dpttypes{$code}->{DEC}) eq 'CODE') {
$state = $dpttypes{$code}->{DEC}->($value, $model, $hash); my $state = $dpttypes{$code}->{DEC}->($value, $model, $hash);
Log3 ($name, 5, qq{KNX_decodeByDpt ($name): gadName= $gadName model= $model code= $code value= $value length-value= } . Log3 ($name, 5, qq{KNX_decodeByDpt ($name): gadName= $gadName model= $model code= $code value= $value length-value= } .
length($value) . qq{ state= $state}); length($value) . qq{ state= $state});
return $state; return $state;
@ -1845,12 +1903,12 @@ sub dec_dpt232 { #RGB-Code
} }
### lookup gadname by gadnumber ### lookup gadname by gadnumber
### called from: KNX_Get, KNX_setOldsyntax # called from: KNX_Get, KNX_setOldsyntax
### entry: $hash, desired gadNO # entry: $hash, desired gadNO
### return: undef on error / gadName # return: undef on error / gadName
sub KNX_gadNameByNO { sub KNX_gadNameByNO {
my $hash = shift; my $hash = shift;
my $groupnr = shift // 1; # default: seaarch for g1 my $groupnr = shift // 1; # default: search for g1
my $targetGadName = undef; my $targetGadName = undef;
foreach my $key (keys %{$hash->{GADDETAILS}}) { foreach my $key (keys %{$hash->{GADDETAILS}}) {
@ -1865,20 +1923,18 @@ sub KNX_gadNameByNO {
########## public utility functions ########## ########## public utility functions ##########
### get state of devices from KNX_Hardware ### get state of devices from KNX_Hardware
### called with devspec as argument # called with devspec as argument
### e.g : KNX_scan() / KNX_scan('device1') / KNX_scan('device1, dev2,dev3,...' / KNX_scan('room=Kueche'), ... # e.g : KNX_scan() / KNX_scan('device1') / KNX_scan('device1, dev2,dev3,...' / KNX_scan('room=Kueche'), ...
### returns number of "gets" executed # returns number of "gets" executed
sub main::KNX_scan { sub main::KNX_scan {
my $devs = shift // 'TYPE=KNX'; # select all if nothing defined my $devs = shift // 'TYPE=KNX'; # select all if nothing defined
my @devlist = ();
if (! $init_done) { # avoid scan before init complete if (! $init_done) { # avoid scan before init complete
Log3 (undef, 2,'KNX_scan command rejected during FHEM-startup!'); Log3 (undef, 2,'KNX_scan command rejected during FHEM-startup!');
return 0; return 0;
} }
@devlist = devspec2array($devs); my @devlist = devspec2array($devs);
my $i = 0; #counter devices my $i = 0; #counter devices
my $j = 0; #counter devices with get my $j = 0; #counter devices with get
@ -1908,7 +1964,7 @@ sub main::KNX_scan {
} }
$j++ if ($k > $k0); $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 (regex= $devs) / $j devices with get / $k "gets" executing...});
doKNX_scan($getsarr) if ($k > 0); doKNX_scan($getsarr) if ($k > 0);
return $k; return $k;
} }