FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-04-30 12:07:09 +00:00
Code Issues Releases Wiki Activity

00_KNXIO.pm: minor internal changes (Forum #127792)

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@28206 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
erwin 2023-11-25 18:02:40 +00:00
parent 8eb0083ec3
commit 416d79ddb0
2 changed files with 84 additions and 59 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: 10_KNX.pm: minor changes, see Forum #122582
- change: 00_KNXIO.pm: minor changes, see Forum #127792
- feature: 76_SolarForecast: graphicHeaderOwnspec: show readings of other devs - feature: 76_SolarForecast: graphicHeaderOwnspec: show readings of other devs
new set/reset batteryTrigger command new set/reset batteryTrigger command
- bugfix: 98_CDCOpenData: warning Net::FTP bei Fhem Start - bugfix: 98_CDCOpenData: warning Net::FTP bei Fhem Start

105
fhem/FHEM/00_KNXIO.pm
View File

@ -1,4 +1,4 @@
## no critic (Modules::RequireVersionVar) ###################################### ## no critic (Modules::RequireVersionVar,Policy::CodeLayout::RequireTidyCode) ##
# $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
@ -63,6 +63,10 @@
# 02/10/2023 Rate limit for write (set/get-cmd) from KNX-Modul # 02/10/2023 Rate limit for write (set/get-cmd) from KNX-Modul
# remove unused imports... # remove unused imports...
# add $readingFnAttributes to AttrList # add $readingFnAttributes to AttrList
# xx/11/2023 performance tuning KNXIO_write
# replace GP_export function
# PBP cleanup -1
# change regex's (unnecessary i)
package KNXIO; ## no critic 'package' package KNXIO; ## no critic 'package'
@ -78,13 +82,15 @@ use TcpServerUtils qw(TcpServer_Open TcpServer_SetLoopbackMode TcpServer_MCastAd
use HttpUtils qw(HttpUtils_gethostbyname ip2str); use HttpUtils qw(HttpUtils_gethostbyname ip2str);
use feature qw(switch); use feature qw(switch);
no if $] >= 5.017011, warnings => 'experimental'; no if $] >= 5.017011, warnings => 'experimental';
use GPUtils qw(GP_Import GP_Export); # Package Helper Fn use GPUtils qw(GP_Import); # Package Helper Fn
### perlcritic parameters ### perlcritic parameters
# these ones are NOT used! (constants,Policy::Modules::RequireFilenameMatchesPackage,NamingConventions::Capitalization) # these ones are NOT used! (constants,Policy::Modules::RequireFilenameMatchesPackage,NamingConventions::Capitalization)
# these ones are NOT used! (RegularExpressions::RequireDotMatchAnything,RegularExpressions::RequireLineBoundaryMatching) # these ones are NOT used! (RegularExpressions::RequireDotMatchAnything,RegularExpressions::RequireLineBoundaryMatching)
# 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 (NamingConventions::Capitalization)
## no critic (Policy::CodeLayout::ProhibitParensWithBuiltins)
## no critic (ValuesAndExpressions::RequireNumberSeparators,ValuesAndExpressions::ProhibitMagicNumbers) ## no critic (ValuesAndExpressions::RequireNumberSeparators,ValuesAndExpressions::ProhibitMagicNumbers)
## no critic (ControlStructures::ProhibitPostfixControls) ## no critic (ControlStructures::ProhibitPostfixControls)
## no critic (Documentation::RequirePodSections) ## no critic (Documentation::RequirePodSections)
@ -110,14 +116,8 @@ BEGIN {
devspec2array devspec2array
TimeNow) TimeNow)
); );
# CommandDefine CommandDelete CommandModify CommandDefMod
# AnalyzePerlCommand EvalSpecials
# modules cmds
} }
# export to main context
GP_Export(qw(Initialize ) );
##################################### #####################################
# global vars/constants # global vars/constants
my $MODELERR = 'MODEL_NOT_DEFINED'; my $MODELERR = 'MODEL_NOT_DEFINED';
@ -125,9 +125,13 @@ my $PAT_IP = '[\d]{1,3}(\.[\d]{1,3}){3}';
my $PAT_PORT = '[\d]{4,5}'; my $PAT_PORT = '[\d]{4,5}';
my $KNXID = 'C'; my $KNXID = 'C';
my $reconnectTO = 10; # Waittime after disconnect my $reconnectTO = 10; # Waittime after disconnect
my $SVNID = '$Id$'; my $SVNID = '$Id$'; ## no critic (Policy::ValuesAndExpressions::RequireInterpolationOfMetachars)
##################################### #####################################
sub main::KNXIO_Initialize {
goto &Initialize;
}
sub Initialize { sub Initialize {
my $hash = shift; my $hash = shift;
$hash->{DefFn} = \&KNXIO_Define; $hash->{DefFn} = \&KNXIO_Define;
@ -155,10 +159,10 @@ sub KNXIO_Define {
my @arg = split(/[\s\t\n]+/xms,$def); my @arg = split(/[\s\t\n]+/xms,$def);
my $name = $arg[0] // return 'KNXIO-define: no name specified'; my $name = $arg[0] // return 'KNXIO-define: no name specified';
$hash->{NAME} = $name; $hash->{NAME} = $name;
$SVNID =~ s/.*\.pm\s([^\s]+\s[^\s]+).*/$1/ixms; $SVNID =~ s/.+[.]pm\s(\S+\s\S+).+/$1/ixms;
$hash->{SVN} = $SVNID; # store svn info in dev hash $hash->{SVN} = $SVNID; # store svn info in dev hash
if ((scalar(@arg) >= 3) && $arg[2] !~ /[HMSTX]/ixms) { if ((scalar(@arg) >= 3) && $arg[2] !~ /[HMSTX]/xms) {
return q{KNXIO-define: invalid mode specified, valid modes are one of: H M S T X}; return q{KNXIO-define: invalid mode specified, valid modes are one of: H M S T X};
} }
my $mode = uc($arg[2]); my $mode = uc($arg[2]);
@ -170,15 +174,15 @@ sub KNXIO_Define {
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-address>" } if (scalar(@arg) < 5); q{ or "define <name> KNXIO S <pathToUnixSocket> <phy-address>" } if (scalar(@arg) < 5);
my ($host,$port) = split(/[:]/ixms,$arg[3]); my ($host,$port) = split(/[:]/xms,$arg[3]);
if ($mode =~ /[MHT]/ixms && $port !~ /$PAT_PORT/ixms) { if ($mode =~ /[MHT]/xms && $port !~ /$PAT_PORT/xms) {
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-address>"}; q{"define <name> KNXIO <H|M|T> <ip-address|hostname>:<port> <phy-address>"};
} }
if ($mode eq q{M}) { # multicast if ($mode eq q{M}) { # multicast
my $host1 = (split(/\./ixms,$host))[0]; my $host1 = (split(/[.]/xms,$host))[0];
return q{KNXIO-define: Multicast address is not in the range of 224.0.0.0 and 239.255.255.255 } . return q{KNXIO-define: Multicast address is not in the range of 224.0.0.0 and 239.255.255.255 } .
q{(default is 224.0.23.12:3671) } if ($host1 < 224 || $host1 > 239); q{(default is 224.0.23.12:3671) } if ($host1 < 224 || $host1 > 239);
$hash->{DeviceName} = $host . q{:} . $port; $hash->{DeviceName} = $host . q{:} . $port;
@ -186,14 +190,15 @@ sub KNXIO_Define {
elsif ($mode eq q{S}) { elsif ($mode eq q{S}) {
$hash->{DeviceName} = 'UNIX:STREAM:' . $host; # $host= path to socket $hash->{DeviceName} = 'UNIX:STREAM:' . $host; # $host= path to socket
} }
elsif ($mode =~ m/[HT]/ixms) { elsif ($mode =~ m/[HT]/xms) {
if ($host !~ /$PAT_IP/ixms) { # not an ip-address, lookup name if ($host !~ /$PAT_IP/xms) { # not an ip-address, lookup name
=pod =begin comment
# blocking variant ! # blocking variant !
my $phost = inet_aton($host); my $phost = inet_aton($host);
return "KNXIO-define: host name $host could not be resolved" if (! defined($phost)); return "KNXIO-define: host name $host could not be resolved" if (! defined($phost));
$host = inet_ntoa($phost); $host = inet_ntoa($phost);
return "KNXIO-define: host name could not be resolved" if (! defined($host)); return "KNXIO-define: host name could not be resolved" if (! defined($host));
=end comment
=cut =cut
# do it non blocking! - use HttpUtils to resolve hostname # do it non blocking! - use HttpUtils to resolve hostname
$hash->{PORT} = $port; # save port... $hash->{PORT} = $port; # save port...
@ -533,13 +538,14 @@ sub KNXIO_Write {
my $acpivalues = {r => 0x00, p => 0x01, w => 0x02}; my $acpivalues = {r => 0x00, p => 0x01, w => 0x02};
if ($msg =~ /^([rwp])([0-9a-f]{5})(.*)$/ixms) { # msg format: <rwp><grpaddr><message> if ($msg =~ /^([rwp])([\da-f]{5})(.*)$/ixms) { # msg format: <rwp><grpaddr><message>
my $acpi = $acpivalues->{$1}<<6; my $acpi = $acpivalues->{$1}<<6;
# my $tcf = ($acpivalues->{$1}>>2 & 0x03); # not needed! # my $tcf = ($acpivalues->{$1}>>2 & 0x03); # not needed!
my $dst = KNXIO_hex2addr($2); my $dst = KNXIO_hex2addr($2);
my $str = $3; my $str = $3 // '00'; # undef on read requ
my $src = KNXIO_hex2addr($hash->{PhyAddr}); my $src = KNXIO_hex2addr($hash->{PhyAddr});
=begin comment
#convert hex-string to array with dezimal values #convert hex-string to array with dezimal values
my @data = map {hex()} $str =~ /(..)/xgms; # PBP 9/2021 my @data = map {hex()} $str =~ /(..)/xgms; # PBP 9/2021
$data[0] = 0 if (scalar(@data) == 0); # in case of read !! $data[0] = 0 if (scalar(@data) == 0); # in case of read !!
@ -555,20 +561,36 @@ sub KNXIO_Write {
KNXIO_Log ($name, 5, q{data=} . sprintf('%02x' x scalar(@data), @data) . KNXIO_Log ($name, 5, q{data=} . sprintf('%02x' x scalar(@data), @data) .
sprintf(' size=%02x acpi=%02x', $datasize, $acpi) . sprintf(' size=%02x acpi=%02x', $datasize, $acpi) .
q{ src=} . KNXIO_addr2hex($src,2) . q{ dst=} . KNXIO_addr2hex($dst,3)); q{ src=} . KNXIO_addr2hex($src,2) . q{ dst=} . KNXIO_addr2hex($dst,3));
my $completemsg = q{}; =end comment
my $ret = 0; =cut
my $data = 0;
if (length($str) > 2) {
$data = pack ('CH*',$acpi,substr($str,2)); # multi byte write/reply
}
else {
$data = pack('C',$acpi + (hex($str) & 0x3f)); # single byte write/reply or read
}
if ($mode =~ /^[ST]$/ixms ) { #format: size | 0x0027 | dst | 0 | data my $datasize = length($data);
$completemsg = pack('nnnCC*',$datasize + 5,0x0027,$dst,0,@data);
KNXIO_Log ($name, 5, q{data=} . unpack('H*', $data) .
sprintf(' size=%d acpi=%02x src=%s dst=%s', $datasize, $acpi,
KNXIO_addr2hex($src,2), KNXIO_addr2hex($dst,3)));
my $completemsg = q{};
if ($mode =~ /^[ST]$/xms ) { #format: size | 0x0027 | dst | 0 | data
$completemsg = pack('nnnC',$datasize + 5,0x0027,$dst,0) . $data;
} }
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('nnnnnnnCC',0x0610,0x0530,$datasize + 16,0x2900,0xBCE0,
$src,$dst,$datasize,0) . $data; # use src addr
} }
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('nnnCCCCnnnnCC',0x0610,0x0420,$datasize + 20,4,
pack('CCnn',$hash->{KNXIOhelper}->{SEQUENCECNTR_W},0,0x1100,0xBCE0) . $hash->{KNXIOhelper}->{CCID},$hash->{KNXIOhelper}->{SEQUENCECNTR_W},
pack('nnCCC*',$src,$dst,$datasize,0,@data); # send TunnelInd 0,0x1100,0xBCE0,$src,$dst,$datasize,0) . $data; # send TunnelInd
} }
## rate limit ## rate limit
@ -595,7 +617,7 @@ sub KNXIO_Write2 {
my $mode = shift(@{$hash->{KNXIOhelper}->{FIFOW}}); my $mode = shift(@{$hash->{KNXIOhelper}->{FIFOW}});
my $completemsg = shift(@{$hash->{KNXIOhelper}->{FIFOW}}); my $completemsg = shift(@{$hash->{KNXIOhelper}->{FIFOW}});
my $ret = q{}; my $ret = 0;
if ($mode eq 'M') { if ($mode eq 'M') {
$ret = ::TcpServer_MCastSend($hash,$completemsg); $ret = ::TcpServer_MCastSend($hash,$completemsg);
} }
@ -633,7 +655,7 @@ sub KNXIO_Rename {
my $logtxt = qq{reading IODev -> $newname}; my $logtxt = qq{reading IODev -> $newname};
if (AttrVal($KNXdev,'IODev',q{}) eq $oldname) { if (AttrVal($KNXdev,'IODev',q{}) eq $oldname) {
delete ($attr{$KNXdev}->{IODev}); delete ($attr{$KNXdev}->{IODev});
$logtxt .= qq{, attr IODev -> deleted!}; $logtxt .= q{, attr IODev -> deleted!};
} }
KNXIO_Log ($KNXdev, 3, qq{device change: $logtxt}); KNXIO_Log ($KNXdev, 3, qq{device change: $logtxt});
} }
@ -712,7 +734,7 @@ sub KNXIO_openDev {
if (exists $hash->{DNSWAIT}) { if (exists $hash->{DNSWAIT}) {
$hash->{DNSWAIT} += 1; $hash->{DNSWAIT} += 1;
if ($hash->{DNSWAIT} > 5) { if ($hash->{DNSWAIT} > 5) {
KNXIO_Log ($name, 2, qq{DNS failed, check ip/hostname}); KNXIO_Log ($name, 2, q{DNS failed, check ip/hostname});
return; return;
} }
InternalTimer(gettimeofday() + 1,\&KNXIO_openDev,$hash); InternalTimer(gettimeofday() + 1,\&KNXIO_openDev,$hash);
@ -723,7 +745,7 @@ sub KNXIO_openDev {
my $reopen = (exists($hash->{NEXT_OPEN}))?1:0; my $reopen = (exists($hash->{NEXT_OPEN}))?1:0;
my $param = $hash->{DeviceName}; # ip:port or UNIX:STREAM:<socket param> my $param = $hash->{DeviceName}; # ip:port or UNIX:STREAM:<socket param>
my ($host, $port, $spath) = split(/[:]/ixms,$param); my ($host, $port, $spath) = split(/[:]/xms,$param);
KNXIO_Log ($name, 5, qq{$mode , $host , $port , reopen= $reopen}); KNXIO_Log ($name, 5, qq{$mode , $host , $port , reopen= $reopen});
@ -822,7 +844,7 @@ sub KNXIO_init {
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $mode = $hash->{model}; my $mode = $hash->{model};
if ($mode =~ m/[ST]/ixms) { if ($mode =~ m/[ST]/xms) {
my $opengrpcon = pack('nnnC',(5,0x26,0,0)); # KNX_OPEN_GROUPCON my $opengrpcon = pack('nnnC',(5,0x26,0,0)); # KNX_OPEN_GROUPCON
::DevIo_SimpleWrite($hash,$opengrpcon,0); ::DevIo_SimpleWrite($hash,$opengrpcon,0);
} }
@ -1097,7 +1119,7 @@ sub KNXIO_decodeCEMI {
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my ($mc, $addlen) = unpack('CC',$buf); my ($mc, $addlen) = unpack('CC',$buf);
if ($mc != 0x29 && $mc != 0x2e) { if ($mc != 0x29 && $mc != 0x2e) {
KNXIO_Log ($name, 4, 'wrong MessageCode ' . sprintf("%02x",$mc) . ', discard packet'); KNXIO_Log ($name, 4, 'wrong MessageCode ' . sprintf('%02x',$mc) . ', discard packet');
return; return;
} }
@ -1105,7 +1127,7 @@ sub KNXIO_decodeCEMI {
my ($ctrlbyte1, $ctrlbyte2, $src, $dst, $tcf, $acpi, @data) = unpack('x' . $addlen . 'CCnnCCC*',$buf); my ($ctrlbyte1, $ctrlbyte2, $src, $dst, $tcf, $acpi, @data) = unpack('x' . $addlen . 'CCnnCCC*',$buf);
if (($ctrlbyte1 & 0xF0) != 0xB0) { # standard frame/no repeat/broadcast - see 03_06_03 EMI_IMI specs if (($ctrlbyte1 & 0xF0) != 0xB0) { # standard frame/no repeat/broadcast - see 03_06_03 EMI_IMI specs
KNXIO_Log ($name, 4, 'wrong ctrlbyte1 ' . sprintf("%02x",$ctrlbyte1) . ', discard packet'); KNXIO_Log ($name, 4, 'wrong ctrlbyte1 ' . sprintf('%02x',$ctrlbyte1) . ', discard packet');
return; return;
} }
my $prio = ($ctrlbyte1 & 0x0C) >>2; # priority my $prio = ($ctrlbyte1 & 0x0C) >>2; # priority
@ -1161,11 +1183,11 @@ sub KNXIO_hex2addr {
my $str = shift; my $str = shift;
my $isphy = shift // 0; my $isphy = shift // 0;
if ($str =~ m/([0-9a-f]{2})([0-9a-f])([0-9a-f]{2})/ixms) { if ($str =~ m/([\da-f]{2})([\da-f])([\da-f]{2})/ixms) {
return (hex($1) << 12) + (hex($2) << 8) + hex($3) if ($isphy == 1); # Phy addr return (hex($1) << 12) + (hex($2) << 8) + hex($3) if ($isphy == 1); # Phy addr
return (hex($1) << 11) | (hex($2) << 8) | hex($3); # GA Addr return (hex($1) << 11) | (hex($2) << 8) | hex($3); # GA Addr
} }
elsif ($str =~ m/([\d]+)\.([\d]+)\.([\d]+)/ixms) { elsif ($str =~ m/([\d]+)[.]([\d]+)[.]([\d]+)/xms) {
return (($1 << 12) & 0x00F000) + (($2 << 8) & 0x0F00) + ($3 & 0x00FF); # phy Addr - limit values! return (($1 << 12) & 0x00F000) + (($2 << 8) & 0x0F00) + ($3 & 0x00FF); # phy Addr - limit values!
} }
return 0; return 0;
@ -1283,6 +1305,7 @@ sub KNXIO_errCodes {
1; 1;
__END__
=pod =pod
@ -1375,11 +1398,11 @@ Suggested parameters for KNXD (Version &gt;= 0.14.30), with systemd&colon;
increase verbosity of Log-Messages, system-wide default is set in "global" device. increase verbosity of Log-Messages, system-wide default is set in "global" device.
For a detailed description see&colon; <a href="#verbose">global-attr verbose</a> <br/></li> For a detailed description see&colon; <a href="#verbose">global-attr verbose</a> <br/></li>
<li><a id="KNXIO-attr-enableKNXscan"></a><b>enableKNXscan</b> - <li><a id="KNXIO-attr-enableKNXscan"></a><b>enableKNXscan</b> -
trigger a KNX_scan cmd at fhemstart or at every connect event. A detailed description of the trigger a KNX_scan cmd at fhemstart or at every connected event. A detailed description of the
<a href="#KNX-utilities">KNX_scan cmd</a> is here! <a href="#KNX-utilities">KNX_scan cmd</a> is here!
<pre><code> 0 - never (default if Attr not defined) <pre><code> 0 - never (default if Attr not defined)
1 - after fhem start (together with INITIALIZED event) 1 - on fhem start (after &lt;device&gt;&colon;INITIALIZED event)
2 - after fhem start and on every connect event</code></pre></li> 2 - on fhem start and on every &lt;device&gt;&colon;connected event</code></pre></li>
</ul> </ul>
</li> </li>
<li><a id="KNXIO-events"></a><strong>Events</strong><br/> <li><a id="KNXIO-events"></a><strong>Events</strong><br/>