10_KNX.pm: fix define-parsing, PBP fixes, (Forum #122582)
git-svn-id: https://svn.fhem.de/fhem/trunk@27139 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
@@ -1,5 +1,7 @@
|
||||
# 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.
|
||||
- bugfix: 00_KNXIO: PBP fixes
|
||||
- bugfix: 10_KNX: fix define-parsing problem, PBP fixes
|
||||
- bugfix: 74_AutomowerConnect: improved error handling, fix missig password bug
|
||||
- feature: 74_AutomowerConnect: add disabledForIntervals, Internal MODEL
|
||||
- feature: 75_AutomowerConnectDevice: add disabledForIntervals, Internal MODEL
|
||||
|
||||
@@ -42,7 +42,8 @@
|
||||
# fix src-addr for Mode M,H
|
||||
# change internal PhyAddr to reabable format + range checking on define.
|
||||
# 19/12/2022 cleanup
|
||||
# xx/01/2023 cleanup, simplify _openDev
|
||||
# 23/01/2023 cleanup, simplify _openDev
|
||||
# xx/02/2023 PBP changes
|
||||
|
||||
|
||||
package KNXIO; ## no critic 'package'
|
||||
@@ -59,9 +60,9 @@ use GPUtils qw(GP_Import GP_Export); # Package Helper Fn
|
||||
|
||||
### perlcritic parameters
|
||||
# these ones are NOT used! (constants,Policy::Modules::RequireFilenameMatchesPackage,NamingConventions::Capitalization)
|
||||
# these ones are NOT used! (RegularExpressions::RequireDotMatchAnything,RegularExpressions::RequireLineBoundaryMatching)
|
||||
### the following percritic items will be ignored global ###
|
||||
## no critic (ValuesAndExpressions::RequireNumberSeparators,ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
## no critic (RegularExpressions::RequireDotMatchAnything,RegularExpressions::RequireLineBoundaryMatching)
|
||||
## no critic (ControlStructures::ProhibitPostfixControls)
|
||||
### no critic (ControlStructures::ProhibitCascadingIfElse)
|
||||
## no critic (Documentation::RequirePodSections)
|
||||
@@ -128,13 +129,13 @@ sub KNXIO_Define {
|
||||
my $hash = shift;
|
||||
my $def = shift;
|
||||
|
||||
my @arg = split(/[\s\t\n]+/x,$def);
|
||||
my @arg = split(/[\s\t\n]+/xms,$def);
|
||||
my $name = $arg[0] // return 'KNXIO-define: no name specified';
|
||||
$hash->{NAME} = $name;
|
||||
$svnid =~ s/.*\.pm\s(.+)Z.*/$1/ix;
|
||||
$svnid =~ s/.*\.pm\s(.+)Z.*/$1/ixms;
|
||||
$hash->{SVN} = $svnid; # store svn info in dev hash
|
||||
|
||||
return q{KNXIO-define: invalid mode specified, valid modes are one of: H M S T X} if ((scalar(@arg) >= 3) && $arg[2] !~ /[HMSTX]/ix);
|
||||
return q{KNXIO-define: invalid mode specified, valid modes are one of: H M S T X} if ((scalar(@arg) >= 3) && $arg[2] !~ /[HMSTX]/ixms);
|
||||
|
||||
my $mode = $arg[2];
|
||||
$hash->{model} = $mode; # use it also for fheminfo statistics
|
||||
@@ -145,13 +146,13 @@ sub KNXIO_Define {
|
||||
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);
|
||||
|
||||
my ($host,$port) = split(/[:]/ix,$arg[3]);
|
||||
my ($host,$port) = split(/[:]/ixms,$arg[3]);
|
||||
|
||||
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>"} if ($mode =~ /[MHT]/ix && $port !~ /$PAT_PORT/ix);
|
||||
q{"define <name> KNXIO <H|M|T> <ip-address|name>:<port> <phy-address>"} if ($mode =~ /[MHT]/ixms && $port !~ /$PAT_PORT/ixms);
|
||||
|
||||
if ($mode eq q{M}) { # multicast
|
||||
my $host1 = (split(/\./ix,$host))[0];
|
||||
my $host1 = (split(/\./ixms,$host))[0];
|
||||
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);
|
||||
$hash->{DeviceName} = $host . q{:} . $port;
|
||||
@@ -159,8 +160,8 @@ sub KNXIO_Define {
|
||||
elsif ($mode eq q{S}) {
|
||||
$hash->{DeviceName} = 'UNIX:STREAM:' . $host; # $host= path to socket
|
||||
}
|
||||
elsif ($mode =~ m/[HT]/ix) {
|
||||
if ($host !~ /$PAT_IP/ix) { # not an ip-address, lookup name
|
||||
elsif ($mode =~ m/[HT]/ixms) {
|
||||
if ($host !~ /$PAT_IP/ixms) { # not an ip-address, lookup name
|
||||
=pod
|
||||
# blocking variant !
|
||||
my $phost = inet_aton($host);
|
||||
@@ -200,7 +201,6 @@ sub KNXIO_Define {
|
||||
|
||||
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) if (! $init_done);
|
||||
return KNXIO_openDev($hash);
|
||||
}
|
||||
@@ -406,16 +406,21 @@ sub KNXIO_ReadH {
|
||||
}
|
||||
$hash->{KNXIOhelper}->{SEQUENCECNTR_W}++;
|
||||
$hash->{KNXIOhelper}->{SEQUENCECNTR_W} = 0 if ($hash->{KNXIOhelper}->{SEQUENCECNTR_W} > 255);
|
||||
RemoveInternalTimer($hash,\&KNXIO_TunnelRequestTO); # all ok, stop timer
|
||||
return RemoveInternalTimer($hash,\&KNXIO_TunnelRequestTO); # all ok, stop timer
|
||||
# RemoveInternalTimer($hash,\&KNXIO_TunnelRequestTO); # all ok, stop timer
|
||||
}
|
||||
elsif ( $responseID == 0x0202) { # Search response
|
||||
if ( $responseID == 0x0202) { # Search response
|
||||
# elsif ( $responseID == 0x0202) { # Search response
|
||||
Log3 ($name, 4, 'KNXIO_ReadH: SearchResponse received');
|
||||
my (@contolpointIp, $controlpointPort) = unpack('x6CCCn',$buf);
|
||||
return;
|
||||
}
|
||||
elsif ( $responseID == 0x0204) { # Decription response
|
||||
Log3 ($name, 4, 'KNXIO_ReadH: DescriptionResponse received');
|
||||
return;
|
||||
}
|
||||
elsif ( $responseID == 0x0206) { # Connection response
|
||||
if ( $responseID == 0x0206) { # Connection response
|
||||
# elsif ( $responseID == 0x0206) { # Connection response
|
||||
($hash->{KNXIOhelper}->{CCID},$errcode) = unpack('x6CC',$buf); # save Comm Channel ID,errcode
|
||||
RemoveInternalTimer($hash,\&KNXIO_keepAlive);
|
||||
if ($errcode > 0) {
|
||||
@@ -429,8 +434,8 @@ sub KNXIO_ReadH {
|
||||
# DoTrigger($name, 'CONNECTED');
|
||||
readingsSingleUpdate($hash, 'state', 'connected', 1);
|
||||
Log3 ($name, 3, qq{KNXIO $name connected});
|
||||
InternalTimer(gettimeofday() + 60, \&KNXIO_keepAlive, $hash); # start keepalive
|
||||
$hash->{KNXIOhelper}->{SEQUENCECNTR} = 0;
|
||||
return InternalTimer(gettimeofday() + 60, \&KNXIO_keepAlive, $hash); # start keepalive
|
||||
}
|
||||
elsif ( $responseID == 0x0208) { # ConnectionState response
|
||||
($hash->{KNXIOhelper}->{CCID}, $errcode) = unpack('x6CC',$buf);
|
||||
@@ -442,9 +447,10 @@ sub KNXIO_ReadH {
|
||||
KNXIO_disconnect($hash);
|
||||
return;
|
||||
}
|
||||
InternalTimer(gettimeofday() + 60, \&KNXIO_keepAlive, $hash);
|
||||
return InternalTimer(gettimeofday() + 60, \&KNXIO_keepAlive, $hash);
|
||||
}
|
||||
elsif ( $responseID == 0x0209) { # Disconnect request
|
||||
if ( $responseID == 0x0209) { # Disconnect request
|
||||
# elsif ( $responseID == 0x0209) { # Disconnect request
|
||||
Log3 ($name, 4, 'KNXIO_ReadH: DisconnectRequest received, restarting connenction');
|
||||
$ccid = unpack('x6C',$buf);
|
||||
$msg = pack('nnnCC',(0x0610,0x020A,8,$ccid,0));
|
||||
@@ -494,7 +500,7 @@ sub KNXIO_Write {
|
||||
|
||||
my $acpivalues = {r => 0x00, p => 0x01, w => 0x02};
|
||||
|
||||
if ($msg =~ /^([rwp])([0-9a-f]{5})(.*)$/ix) { # msg format: <rwp><grpaddr><message>
|
||||
if ($msg =~ /^([rwp])([0-9a-f]{5})(.*)$/ixms) { # msg format: <rwp><grpaddr><message>
|
||||
my $acpi = $acpivalues->{$1}<<6;
|
||||
# my $tcf = ($acpivalues->{$1}>>2 & 0x03); # not needed!
|
||||
my $dst = KNXIO_hex2addr($2);
|
||||
@@ -502,7 +508,7 @@ sub KNXIO_Write {
|
||||
my $src = KNXIO_hex2addr($hash->{PhyAddr});
|
||||
|
||||
#convert hex-string to array with dezimal values
|
||||
my @data = map {hex()} $str =~ /(..)/xg; # PBP 9/2021
|
||||
my @data = map {hex()} $str =~ /(..)/xgms; # PBP 9/2021
|
||||
$data[0] = 0 if (scalar(@data) == 0); # in case of read !!
|
||||
my $datasize = scalar(@data);
|
||||
|
||||
@@ -519,7 +525,7 @@ sub KNXIO_Write {
|
||||
my $completemsg = q{};
|
||||
my $ret = 0;
|
||||
|
||||
if ($mode =~ /^[ST]$/ix ) { #format: size | 0x0027 | dst | 0 | data
|
||||
if ($mode =~ /^[ST]$/ixms ) { #format: size | 0x0027 | dst | 0 | data
|
||||
$completemsg = pack('nnnCC*',$datasize + 5,0x0027,$dst,0,@data);
|
||||
}
|
||||
elsif ($mode eq 'M') {
|
||||
@@ -669,16 +675,7 @@ sub KNXIO_openDev {
|
||||
|
||||
my $reopen = (exists($hash->{NEXT_OPEN}))?1:0;
|
||||
my $param = $hash->{DeviceName}; # ip:port or UNIX:STREAM:<socket param>
|
||||
=pod
|
||||
my ($ccode, $host, $port) = split(/[:]/ix,$param);
|
||||
if (! defined($port)) {
|
||||
$port = $host;
|
||||
$host = $ccode;
|
||||
$ccode = undef;
|
||||
}
|
||||
$host = $port if ($param =~ /UNIX:STREAM:/ix);
|
||||
=cut
|
||||
my ($host, $port) = split(/[:]/ix,$param);
|
||||
my ($host, $port) = split(/[:]/ixms,$param);
|
||||
|
||||
Log3 ($name, 5, qq{KNXIO_openDev ($name): $mode , $host , $port , reopen= $reopen});
|
||||
|
||||
@@ -707,7 +704,7 @@ sub KNXIO_openDev {
|
||||
|
||||
### socket mode
|
||||
elsif ($mode eq 'S') {
|
||||
$host = (split(/[:]/ix,$param))[2]; # UNIX:STREAM:<socket path>
|
||||
$host = (split(/[:]/ixms,$param))[2]; # UNIX:STREAM:<socket path>
|
||||
if (!(-S -r -w $host) && $init_done) {
|
||||
Log3 ($name, 2, q{KNXIO_openDev ($name): Socket not available - (knxd running?)});
|
||||
return qq{KNXIO_openDev ($name): Socket not available - (knxd running?)};
|
||||
@@ -758,7 +755,7 @@ sub KNXIO_init {
|
||||
my $name = $hash->{NAME};
|
||||
my $mode = $hash->{model};
|
||||
|
||||
if ($mode =~ m/[ST]/ix) {
|
||||
if ($mode =~ m/[ST]/ixms) {
|
||||
my $opengrpcon = pack('nnnC',(5,0x26,0,0)); # KNX_OPEN_GROUPCON
|
||||
DevIo_SimpleWrite($hash,$opengrpcon,0);
|
||||
}
|
||||
@@ -1060,11 +1057,11 @@ sub KNXIO_hex2addr {
|
||||
my $str = shift;
|
||||
my $isphy = shift // 0;
|
||||
|
||||
if ($str =~ m/([0-9a-f]{2})([0-9a-f])([0-9a-f]{2})/ix) {
|
||||
if ($str =~ m/([0-9a-f]{2})([0-9a-f])([0-9a-f]{2})/ixms) {
|
||||
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
|
||||
}
|
||||
elsif ($str =~ m/([\d]+)\.([\d]+)\.([\d]+)/ix) {
|
||||
elsif ($str =~ m/([\d]+)\.([\d]+)\.([\d]+)/ixms) {
|
||||
return (($1 << 12) & 0x00F000) + (($2 << 8) & 0x0F00) + ($3 & 0x00FF); # phy Addr - limit values!
|
||||
}
|
||||
return 0;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user