FHEM/mod-NUKI
1
0
Fork 0
Code Issues Pull Requests Releases 3 Wiki Activity

Merge pull request 'patch-improvementErrorHandling' (#21) from patch-improvementErrorHandling into dev

Browse Source 
Reviewed-on: #21
This commit is contained in:
Marko Oldenburg 2021-12-10 20:46:36 +01:00
commit ca58793d03
5 changed files with 433 additions and 337 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
FHEM/73_NUKIBridge.pm
View File

@ -1,6 +1,6 @@
############################################################################### ###############################################################################
# #
# Developed with Kate # Developed with VSCodium
# #
# (c) 2016-2021 Copyright: Marko Oldenburg (fhemdevelopment at cooltux dot net) # (c) 2016-2021 Copyright: Marko Oldenburg (fhemdevelopment at cooltux dot net)
# All rights reserved # All rights reserved
@ -43,6 +43,14 @@ use warnings;
use FHEM::Meta; use FHEM::Meta;
require FHEM::Devices::Nuki::Bridge; require FHEM::Devices::Nuki::Bridge;
use GPUtils qw(GP_Import);
BEGIN {
# Import from main context
GP_Import(qw( readingFnAttributes ));
}
sub ::NUKIBridge_Initialize { goto &Initialize } sub ::NUKIBridge_Initialize { goto &Initialize }
sub Initialize { sub Initialize {
@ -68,7 +76,7 @@ sub Initialize {
. 'webhookFWinstance:' . 'webhookFWinstance:'
. $webhookFWinstance . ' ' . $webhookFWinstance . ' '
. 'webhookHttpHostname ' . 'webhookHttpHostname '
. $::readingFnAttributes; . $readingFnAttributes;
return FHEM::Meta::InitMod( __FILE__, $hash ); return FHEM::Meta::InitMod( __FILE__, $hash );
} }

14
FHEM/74_NUKIDevice.pm
View File

@ -1,6 +1,6 @@
############################################################################### ###############################################################################
# #
# Developed with Kate # Developed with VSCodium
# #
# (c) 2016-2021 Copyright: Marko Oldenburg (fhemdevelopment at cooltux dot net) # (c) 2016-2021 Copyright: Marko Oldenburg (fhemdevelopment at cooltux dot net)
# All rights reserved # All rights reserved
@ -32,11 +32,19 @@ use warnings;
use FHEM::Meta; use FHEM::Meta;
require FHEM::Devices::Nuki::Device; require FHEM::Devices::Nuki::Device;
use GPUtils qw(GP_Import);
BEGIN {
# Import from main context
GP_Import(qw( readingFnAttributes ));
}
main::LoadModule('NUKIBridge'); main::LoadModule('NUKIBridge');
sub ::NUKIDevice_Initialize { goto &Initialize } sub ::NUKIDevice_Initialize { goto &Initialize }
sub Initialize($) { sub Initialize {
my ($hash) = @_; my ($hash) = @_;
$hash->{Match} = '^{.*}$'; $hash->{Match} = '^{.*}$';
@ -52,7 +60,7 @@ sub Initialize($) {
'IODev ' 'IODev '
. 'model:smartlock,opener,smartdoor,smartlock3 ' . 'model:smartlock,opener,smartdoor,smartlock3 '
. 'disable:1 ' . 'disable:1 '
. $::readingFnAttributes; . $readingFnAttributes;
return FHEM::Meta::InitMod( __FILE__, $hash ); return FHEM::Meta::InitMod( __FILE__, $hash );
} }

8
controls_NukiSmart.txt
View File

@ -1,4 +1,4 @@
UPD 2021-12-05_12:10:05 9217 FHEM/73_NUKIBridge.pm UPD 2021-12-10_20:21:10 9332 FHEM/73_NUKIBridge.pm
UPD 2021-12-05_12:10:05 7569 FHEM/74_NUKIDevice.pm UPD 2021-12-10_20:22:28 7681 FHEM/74_NUKIDevice.pm
UPD 2021-12-05_12:14:27 40875 lib/FHEM/Devices/Nuki/Bridge.pm UPD 2021-12-10_19:44:48 42801 lib/FHEM/Devices/Nuki/Bridge.pm
UPD 2021-12-05_12:10:05 15802 lib/FHEM/Devices/Nuki/Device.pm UPD 2021-12-10_20:17:22 16247 lib/FHEM/Devices/Nuki/Device.pm

549
lib/FHEM/Devices/Nuki/Bridge.pm
View File

@ -1,6 +1,6 @@
############################################################################### ###############################################################################
# #
# Developed with Kate # Developed with VSCodium
# #
# (c) 2016-2021 Copyright: Marko Oldenburg (fhemdevelopment at cooltux dot net) # (c) 2016-2021 Copyright: Marko Oldenburg (fhemdevelopment at cooltux dot net)
# All rights reserved # All rights reserved
@ -39,25 +39,36 @@ package FHEM::Devices::Nuki::Bridge;
use strict; use strict;
use warnings; use warnings;
use experimental qw( switch );
use FHEM::Meta; use FHEM::Meta;
use HttpUtils; use HttpUtils;
use GPUtils qw(GP_Import);
BEGIN {
# Import from main context
GP_Import(
qw( init_done
defs
modules
data
)
);
}
# try to use JSON::MaybeXS wrapper # try to use JSON::MaybeXS wrapper
# for chance of better performance + open code # for chance of better performance + open code
eval { eval {
require JSON::MaybeXS; require JSON::MaybeXS;
import JSON::MaybeXS qw( decode_json encode_json ); import JSON::MaybeXS qw( decode_json encode_json );
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# try to use JSON wrapper # try to use JSON wrapper
# for chance of better performance # for chance of better performance
eval { eval {
# JSON preference order # JSON preference order
local $ENV{PERL_JSON_BACKEND} = local $ENV{PERL_JSON_BACKEND} =
'Cpanel::JSON::XS,JSON::XS,JSON::PP,JSON::backportPP' 'Cpanel::JSON::XS,JSON::XS,JSON::PP,JSON::backportPP'
@ -66,10 +77,7 @@ if ($@) {
require JSON; require JSON;
import JSON qw( decode_json encode_json ); import JSON qw( decode_json encode_json );
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# In rare cases, Cpanel::JSON::XS may # In rare cases, Cpanel::JSON::XS may
# be installed but JSON|JSON::MaybeXS not ... # be installed but JSON|JSON::MaybeXS not ...
@ -77,10 +85,7 @@ if ($@) {
require Cpanel::JSON::XS; require Cpanel::JSON::XS;
import Cpanel::JSON::XS qw(decode_json encode_json); import Cpanel::JSON::XS qw(decode_json encode_json);
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# In rare cases, JSON::XS may # In rare cases, JSON::XS may
# be installed but JSON not ... # be installed but JSON not ...
@ -88,10 +93,7 @@ if ($@) {
require JSON::XS; require JSON::XS;
import JSON::XS qw(decode_json encode_json); import JSON::XS qw(decode_json encode_json);
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# Fallback to built-in JSON which SHOULD # Fallback to built-in JSON which SHOULD
# be available since 5.014 ... # be available since 5.014 ...
@ -99,20 +101,17 @@ if ($@) {
require JSON::PP; require JSON::PP;
import JSON::PP qw(decode_json encode_json); import JSON::PP qw(decode_json encode_json);
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# Fallback to JSON::backportPP in really rare cases # Fallback to JSON::backportPP in really rare cases
require JSON::backportPP; require JSON::backportPP;
import JSON::backportPP qw(decode_json encode_json); import JSON::backportPP qw(decode_json encode_json);
1; 1;
} };
} };
} };
} };
} };
######## Begin Bridge ######## Begin Bridge
@ -138,11 +137,16 @@ my %lockActionsOpener = (
); );
sub Define { sub Define {
use version 0.60;
my $hash = shift; my $hash = shift;
my $def = shift // return; my $def = shift // return;
my $version;
return $@ unless ( FHEM::Meta::SetInternals($hash) ); return $@ unless ( FHEM::Meta::SetInternals($hash) );
use version 0.60; our $VERSION = FHEM::Meta::Get( $hash, 'version' );
$version = FHEM::Meta::Get( $hash, 'version' );
our $VERSION = $version;
my ( $name, undef, $host, $token ) = split( m{\s+}xms, $def ); my ( $name, undef, $host, $token ) = split( m{\s+}xms, $def );
@ -185,7 +189,7 @@ sub Define {
$hash->{fhem}{infix} = $infix; $hash->{fhem}{infix} = $infix;
} }
$::modules{NUKIBridge}{defptr}{ $hash->{HOST} } = $hash; $modules{NUKIBridge}{defptr}{ $hash->{HOST} } = $hash;
return; return;
} }
@ -201,7 +205,7 @@ sub Undef {
} }
::RemoveInternalTimer($hash); ::RemoveInternalTimer($hash);
delete $::modules{NUKIBridge}{defptr}{ $hash->{HOST} }; delete $modules{NUKIBridge}{defptr}{ $hash->{HOST} };
return; return;
} }
@ -211,8 +215,9 @@ sub Attr {
my $name = shift; my $name = shift;
my $attrName = shift; my $attrName = shift;
my $attrVal = shift; my $attrVal = shift;
my $attrWebhookCheck;
my $hash = $::defs{$name}; my $hash = $defs{$name};
my $orig = $attrVal; my $orig = $attrVal;
if ( $attrName eq 'disable' ) { if ( $attrName eq 'disable' ) {
@ -251,15 +256,30 @@ sub Attr {
} }
} }
###################### $attrWebhookCheck = AttrWebhookCheck( $cmd, $name, $attrName, $attrVal );
#### webhook #########
return ( return $attrWebhookCheck
"Invalid value for attribute $attrName: can only by FQDN or IPv4 or IPv6 address" if ( defined($attrWebhookCheck) );
)
if ( $attrVal return AttrWebhook( $hash, $cmd, $attrName, $attrVal );
&& $attrName eq 'webhookHttpHostname' }
&& $attrVal !~ /^([A-Za-z_.0-9]+\.[A-Za-z_.0-9]+)|[0-9:]+$/ );
sub AttrWebhookCheck {
my $cmd = shift;
my $name = shift;
my $attrName = shift;
my $attrVal = shift // return 'No given attribut value';
######################
#### webhook check #########
### Test ist ohne Funktion. Noch mal drüber schauen
# return (
# "Invalid value for attribute $attrName: can only by FQDN or IPv4 or IPv6 address"
# )
# if ( $attrVal
# && $attrName eq 'webhookHttpHostname'
# && $attrVal !~ m{\A([A-Za-z_.0-9]+\.[A-Za-z_.0-9]+)|[0-9:]+\z}xms );
return ( return (
"Invalid value for attribute $attrName: FHEMWEB instance $attrVal not existing" "Invalid value for attribute $attrName: FHEMWEB instance $attrVal not existing"
@ -267,17 +287,21 @@ sub Attr {
if ( if (
$attrVal $attrVal
&& $attrName eq 'webhookFWinstance' && $attrName eq 'webhookFWinstance'
&& ( !defined( $::defs{$attrVal} ) && ( !defined( $defs{$attrVal} )
|| $::defs{$attrVal}{TYPE} ne 'FHEMWEB' ) || $defs{$attrVal}{TYPE} ne 'FHEMWEB' )
); );
return ( return;
"Invalid value for attribute $attrName: needs to be an integer value") }
if ( $attrVal
&& $attrName eq 'webhookPort'
&& $attrVal !~ /^\d+$/ );
if ( $attrName =~ /^webhook.*/ ) { sub AttrWebhook {
my $hash = shift;
my $cmd = shift;
my $attrName = shift;
my $attrVal = shift;
my $name = $hash->{NAME};
if ( $attrName =~ m{\Awebhook.*}xms ) {
my $webhookHttpHostname = ( my $webhookHttpHostname = (
$attrName eq 'webhookHttpHostname' && defined($attrVal) $attrName eq 'webhookHttpHostname' && defined($attrVal)
@ -295,14 +319,8 @@ sub Attr {
. ::AttrVal( $webhookFWinstance, 'webname', 'fhem' ) . ::AttrVal( $webhookFWinstance, 'webname', 'fhem' )
. '/NUKIBridge' . '-' . '/NUKIBridge' . '-'
. $hash->{HOST}; . $hash->{HOST};
$hash->{WEBHOOK_PORT} = ( $hash->{WEBHOOK_PORT} = ::InternalVal( $webhookFWinstance, 'PORT', '' );
$attrName eq 'webhookPort' ? $attrVal : ::AttrVal( $hash->{WEBHOOK_URL} = '';
$name, 'webhookPort',
::InternalVal( $webhookFWinstance, 'PORT', '' )
)
);
$hash->{WEBHOOK_URL} = '';
$hash->{WEBHOOK_COUNTER} = 0; $hash->{WEBHOOK_COUNTER} = 0;
if ( $webhookHttpHostname ne '' && $hash->{WEBHOOK_PORT} ne '' ) { if ( $webhookHttpHostname ne '' && $hash->{WEBHOOK_PORT} ne '' ) {
@ -322,7 +340,7 @@ sub Attr {
# Write( $hash, 'callback/add', $url, undef, undef ) # Write( $hash, 'callback/add', $url, undef, undef )
Write( $hash, 'callback/add', '{"param":"' . $url . '"}' ) Write( $hash, 'callback/add', '{"param":"' . $url . '"}' )
if ($::init_done); if ($init_done);
$hash->{WEBHOOK_REGISTER} = 'sent'; $hash->{WEBHOOK_REGISTER} = 'sent';
} }
else { else {
@ -334,7 +352,6 @@ sub Attr {
} }
sub Notify { sub Notify {
my $hash = shift; my $hash = shift;
my $dev = shift // return; my $dev = shift // return;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@ -349,19 +366,15 @@ sub Notify {
FirstRun($hash) FirstRun($hash)
if ( if (
( (
grep /^INITIALIZED$/, grep { /^INITIALIZED$/x } @{$events}
@{$events} or grep { /^REREADCFG$/x } @{$events}
or grep /^REREADCFG$/, or grep { /^MODIFIED.$name$/x } @{$events}
@{$events} or grep { /^DEFINED.$name$/x } @{$events}
or grep /^MODIFIED.$name$/,
@{$events}
or grep /^DEFINED.$name$/,
@{$events}
) )
&& $hash->{HOST} ne 'discover' && $hash->{HOST} ne 'discover'
&& $hash->{TOKEN} ne 'discover' && $hash->{TOKEN} ne 'discover'
&& $devname eq 'global' && $devname eq 'global'
&& $::init_done && $init_done
); );
return; return;
@ -378,9 +391,9 @@ sub addExtension {
"NUKIBridge ($name) - Registering NUKIBridge for webhook URI $url ..." "NUKIBridge ($name) - Registering NUKIBridge for webhook URI $url ..."
); );
$::data{FWEXT}{$url}{deviceName} = $name; $data{FWEXT}{$url}{deviceName} = $name;
$::data{FWEXT}{$url}{FUNC} = $func; $data{FWEXT}{$url}{FUNC} = $func;
$::data{FWEXT}{$url}{LINK} = $link; $data{FWEXT}{$url}{LINK} = $link;
return 1; return 1;
} }
@ -389,13 +402,13 @@ sub removeExtension {
my $link = shift; my $link = shift;
my $url = '/' . $link; my $url = '/' . $link;
my $name = $::data{FWEXT}{$url}{deviceName}; my $name = $data{FWEXT}{$url}{deviceName};
::Log3( $name, 2, ::Log3( $name, 2,
"NUKIBridge ($name) - Unregistering NUKIBridge for webhook URL $url..." "NUKIBridge ($name) - Unregistering NUKIBridge for webhook URL $url..."
) if ( defined($name) ); ) if ( defined($name) );
delete $::data{FWEXT}{$url}; delete $data{FWEXT}{$url};
return; return;
} }
@ -409,52 +422,59 @@ sub Set {
my $endpoint; my $endpoint;
my $param; my $param;
if ( lc($cmd) eq 'getdevicelist' ) { $cmd = lc($cmd);
return 'usage: getDeviceList' if ($arg);
$endpoint = 'list';
}
elsif ( $cmd eq 'info' ) {
$endpoint = 'info';
}
elsif ( lc($cmd) eq 'fwupdate' ) {
$endpoint = 'fwupdate';
}
elsif ( $cmd eq 'reboot' ) {
return 'usage: reboot' if ( defined($arg) );
$endpoint = 'reboot'; given ($cmd) {
} when ('getdevicelist') {
elsif ( lc($cmd) eq 'clearlog' ) { return 'usage: getDeviceList' if ( defined($arg) );
return 'usage: clearLog' if ( defined($arg) ); $endpoint = 'list';
}
when ('info') {
return 'usage: info' if ( defined($arg) );
$endpoint = 'info';
}
when ('fwupdate') {
return 'usage: fwUpdate' if ( defined($arg) );
$endpoint = 'fwupdate';
}
when ('reboot') {
return 'usage: freboot' if ( defined($arg) );
$endpoint = 'reboot';
}
when ('clearlog') {
return 'usage: clearLog' if ( defined($arg) );
$endpoint = 'clearlog';
}
when ('factoryreset') {
return 'usage: factoryReset' if ( defined($arg) );
$endpoint = 'factoryreset';
}
$endpoint = 'clearlog'; when ('callbackremove') {
} return 'usage: callbackRemove'
elsif ( lc($cmd) eq 'factoryreset' ) { if ( split( m{\s+}xms, $arg ) > 1 );
return 'usage: clearLog' if ( defined($arg) ); my $id = ( defined($arg) ? $arg : 0 );
$endpoint = 'callback/remove';
$param = '{"param":"' . $id . '"}';
}
$endpoint = 'factoryReset'; when ('configauth') {
} return 'usage: configAuth' if ( split( m{\s+}xms, $arg ) > 1 );
elsif ( lc($cmd) eq 'callbackremove' ) { $endpoint = 'clearlog';
return 'usage: callbackRemove' if ( split( m{\s+}xms, $arg ) > 1 ); my $configAuth = 'enable=' . ( $arg eq 'enable' ? 1 : 0 );
$endpoint = 'configAuth';
$param = '{"param":"' . $configAuth . '"}';
}
my $id = ( defined($arg) ? $arg : 0 ); default {
$endpoint = 'callback/remove'; my $list = '';
$param = '{"param":"' . $id . '"}'; $list .= 'info:noArg getDeviceList:noArg ';
} $list .=
elsif ( lc($cmd) eq 'configauth' ) {
return 'usage: configAuth' if ( split( m{\s+}xms, $arg ) > 1 );
my $configAuth = 'enable=' . ( $arg eq 'enable' ? 1 : 0 );
$endpoint = 'configAuth';
$param = '{"param":"' . $configAuth . '"}';
}
else {
my $list = '';
$list .= 'info:noArg getDeviceList:noArg ';
$list .=
'clearLog:noArg fwUpdate:noArg reboot:noArg factoryReset:noArg configAuth:enable,disable' 'clearLog:noArg fwUpdate:noArg reboot:noArg factoryReset:noArg configAuth:enable,disable'
if ( ::ReadingsVal( $name, 'bridgeType', 'Software' ) eq 'Hardware' ); if ( ::ReadingsVal( $name, 'bridgeType', 'Software' ) eq
return ( 'Unknown argument ' . $cmd . ', choose one of ' . $list ); 'Hardware' );
return ( 'Unknown argument ' . $cmd . ', choose one of ' . $list );
}
} }
Write( $hash, $endpoint, $param ) Write( $hash, $endpoint, $param )
@ -471,23 +491,25 @@ sub Get {
my $endpoint; my $endpoint;
if ( lc($cmd) eq 'logfile' ) { $cmd = lc($cmd);
return 'usage: logFile' if ( defined($arg) ); given ($cmd) {
when ( $cmd eq 'logfile' ) {
return 'usage: logFile' if ( defined($arg) );
$endpoint = 'log';
}
when ( $cmd eq 'callbacklist' ) {
return 'usage: callbackList' if ( defined($arg) );
$endpoint = 'callback/list';
}
default {
my $list = '';
$list .= 'callbackList:noArg ';
$list .= 'logFile:noArg'
if ( ::ReadingsVal( $name, 'bridgeType', 'Software' ) eq
'Hardware' );
$endpoint = 'log'; return 'Unknown argument ' . $cmd . ', choose one of ' . $list;
} }
elsif ( lc($cmd) eq 'callbacklist' ) {
return 'usage: callbackList' if ( defined($arg) );
$endpoint = 'callback/list';
}
else {
my $list = '';
$list .= 'callbackList:noArg ';
$list .= 'logFile:noArg'
if ( ::ReadingsVal( $name, 'bridgeType', 'Software' ) eq 'Hardware' );
return 'Unknown argument ' . $cmd . ', choose one of ' . $list;
} }
return Write( $hash, $endpoint, undef ); return Write( $hash, $endpoint, undef );
@ -533,8 +555,9 @@ sub Write {
my $hash = shift; my $hash = shift;
my $endpoint = shift // return; my $endpoint = shift // return;
my $json = shift; my $json = shift;
my $decode_json;
my $decode_json = eval { decode_json($json) } $decode_json = eval { decode_json($json) }
if ( defined($json) ); if ( defined($json) );
my $nukiId = $decode_json->{nukiId} // undef; my $nukiId = $decode_json->{nukiId} // undef;
@ -658,34 +681,11 @@ sub BridgeCall {
return; return;
} }
sub Distribution { sub DistributionErrHandle1 {
my $hash = shift;
my $param = shift; my $param = shift;
my $err = shift; my $err = shift;
my $json = shift; my $name = $hash->{NAME};
my $hash = $param->{hash};
# my $doTrigger = $param->{doTrigger};
my $name = $hash->{NAME};
my $host = $hash->{HOST};
my $dhash = $hash;
$dhash = $::modules{NUKIDevice}{defptr}{ $param->{'nukiId'} }
if ( defined( $param->{'nukiId'} ) );
my $dname = $dhash->{NAME};
::Log3( $name, 4, "NUKIBridge ($name) - Response JSON: $json" );
::Log3( $name, 4, "NUKIBridge ($name) - Response ERROR: $err" );
::Log3( $name, 4, "NUKIBridge ($name) - Response CODE: $param->{code}" )
if ( defined( $param->{code} )
&& $param->{code} );
$hash->{helper}->{iowrite} = 0
if ( $hash->{helper}->{iowrite} == 1 );
::readingsBeginUpdate($hash);
if ( defined($err) ) { if ( defined($err) ) {
if ( $err ne '' ) { if ( $err ne '' ) {
@ -709,6 +709,18 @@ sub Distribution {
} }
} }
return;
}
sub DistributionErrHandle2 {
my $hash = shift;
my $err = shift;
my $param = shift;
my $json = shift;
my $name = $hash->{NAME};
# 2021.12.10 13:55:43 1: PERL WARNING: Use of uninitialized value $json in string eq at lib/FHEM/Devices/Nuki/Bridge.pm line 722.
# Can't use string ("{"success": false}") as a HASH ref while "strict refs" in use at lib/FHEM/Devices/Nuki/Bridge.pm line 722.
if ( ( $json eq '' || $json =~ /Unavailable/i ) if ( ( $json eq '' || $json =~ /Unavailable/i )
&& exists( $param->{code} ) && exists( $param->{code} )
&& $param->{code} != 200 ) && $param->{code} != 200 )
@ -758,6 +770,14 @@ sub Distribution {
. ' without any data after requesting' ); . ' without any data after requesting' );
} }
return;
}
sub DistributionErrHandle3 {
my ( $hash, $err, $dhash, $param, $json ) = @_;
my $name = $hash->{NAME};
if ( ( $json =~ /Error/i ) if ( ( $json =~ /Error/i )
&& exists( $param->{code} ) ) && exists( $param->{code} ) )
{ {
@ -781,6 +801,49 @@ sub Distribution {
return $param->{code}; return $param->{code};
} }
}
sub Distribution {
my $param = shift;
my $err = shift;
my $json = shift;
my $errHandle1;
my $errHandle2;
my $errHandle3;
my $hash = $param->{hash};
# my $doTrigger = $param->{doTrigger};
my $name = $hash->{NAME};
my $host = $hash->{HOST};
my $dhash = $hash;
$dhash = $modules{NUKIDevice}{defptr}{ $param->{'nukiId'} }
if ( defined( $param->{'nukiId'} ) );
::Log3( $name, 4, "NUKIBridge ($name) - Response JSON: $json" );
::Log3( $name, 4, "NUKIBridge ($name) - Response ERROR: $err" );
::Log3( $name, 4, "NUKIBridge ($name) - Response CODE: $param->{code}" )
if ( defined( $param->{code} )
&& $param->{code} );
$hash->{helper}->{iowrite} = 0
if ( $hash->{helper}->{iowrite} == 1 );
::readingsBeginUpdate($hash);
$errHandle1 = DistributionErrHandle1( $hash, $param, $err );
return $errHandle1
if ($errHandle1);
$errHandle2 = DistributionErrHandle2( $hash, $err, $param, $json );
return $errHandle2
if ($errHandle2);
$errHandle3 = DistributionErrHandle3( $hash, $err, $dhash, $param, $json );
return $errHandle3
if ($errHandle3);
delete $hash->{helper}->{lastDeviceAction} delete $hash->{helper}->{lastDeviceAction}
if ( defined( $hash->{helper}->{lastDeviceAction} ) if ( defined( $hash->{helper}->{lastDeviceAction} )
@ -825,6 +888,70 @@ sub Distribution {
return; return;
} }
sub HandlingListInfo {
my $hash = shift;
my $json = shift;
my $decode_json = shift;
my $endpoint = shift;
my $name = $hash->{NAME};
if (
(
ref($decode_json) eq 'ARRAY'
&& scalar( @{$decode_json} ) > 0
&& $endpoint eq 'list'
)
|| ( ref($decode_json) eq 'HASH'
&& ref( $decode_json->{scanResults} ) eq 'ARRAY'
&& scalar( @{ $decode_json->{scanResults} } ) > 0
&& $endpoint eq 'info' )
)
{
my @buffer;
@buffer = split( '\[', $json )
if ( $endpoint eq 'list' );
@buffer = split( '"scanResults": \[', $json )
if ( $endpoint eq 'info' );
my ( $sjson, $tail ) = ParseJSON( $hash, $buffer[1] );
while ($sjson) {
::Log3( $name, 5,
"NUKIBridge ($name) - Decoding JSON message. Length: "
. length($sjson)
. " Content: "
. $sjson );
::Log3( $name, 5,
"NUKIBridge ($name) - Vor Sub: Laenge JSON: "
. length($sjson)
. " Content: "
. $sjson
. " Tail: "
. $tail );
::Dispatch( $hash, $sjson, undef )
if ( defined($tail)
&& $tail );
( $sjson, $tail ) = ParseJSON( $hash, $tail );
::Log3( $name, 5,
"NUKIBridge ($name) - Nach Sub: Laenge JSON: "
. length($sjson)
. " Content: "
. $sjson
. " Tail: "
. $tail );
}
}
WriteReadings( $hash, $decode_json, $endpoint )
if ( $endpoint eq 'info' );
return;
}
sub ResponseProcessing { sub ResponseProcessing {
my $hash = shift; my $hash = shift;
my $json = shift; my $json = shift;
@ -837,11 +964,11 @@ sub ResponseProcessing {
::Log3( $name, 3, "NUKIBridge ($name) - empty answer received" ); ::Log3( $name, 3, "NUKIBridge ($name) - empty answer received" );
return; return;
} }
elsif ( $json =~ m'HTTP/1.1 200 OK' ) { elsif ( $json =~ m{'HTTP/1.1 200 OK'}xms ) {
::Log3( $name, 4, "NUKIBridge ($name) - empty answer received" ); ::Log3( $name, 4, "NUKIBridge ($name) - empty answer received" );
return; return;
} }
elsif ( $json !~ m/^[\[{].*[}\]]$/ ) { elsif ( $json !~ m{^[\[{].*[}\]]$}xms ) {
::Log3( $name, 3, "NUKIBridge ($name) - invalid json detected: $json" ); ::Log3( $name, 3, "NUKIBridge ($name) - invalid json detected: $json" );
return ("NUKIBridge ($name) - invalid json detected: $json"); return ("NUKIBridge ($name) - invalid json detected: $json");
} }
@ -855,70 +982,18 @@ sub ResponseProcessing {
if ( $endpoint eq 'list' if ( $endpoint eq 'list'
|| $endpoint eq 'info' ) || $endpoint eq 'info' )
{ {
if ( HandlingListInfo( $hash, $json, $decode_json, $endpoint );
(
ref($decode_json) eq 'ARRAY'
&& scalar( @{$decode_json} ) > 0
&& $endpoint eq 'list'
)
|| ( ref($decode_json) eq 'HASH'
&& ref( $decode_json->{scanResults} ) eq 'ARRAY'
&& scalar( @{ $decode_json->{scanResults} } ) > 0
&& $endpoint eq 'info' )
)
{
my @buffer;
@buffer = split( '\[', $json )
if ( $endpoint eq 'list' );
@buffer = split( '"scanResults": \[', $json )
if ( $endpoint eq 'info' );
my ( $json, $tail ) = ParseJSON( $hash, $buffer[1] );
while ($json) {
::Log3( $name, 5,
"NUKIBridge ($name) - Decoding JSON message. Length: "
. length($json)
. " Content: "
. $json );
::Log3( $name, 5,
"NUKIBridge ($name) - Vor Sub: Laenge JSON: "
. length($json)
. " Content: "
. $json
. " Tail: "
. $tail );
::Dispatch( $hash, $json, undef )
if ( defined($tail)
&& $tail );
( $json, $tail ) = ParseJSON( $hash, $tail );
::Log3( $name, 5,
"NUKIBridge ($name) - Nach Sub: Laenge JSON: "
. length($json)
. " Content: "
. $json
. " Tail: "
. $tail );
}
}
WriteReadings( $hash, $decode_json, $endpoint )
if ( $endpoint eq 'info' );
return;
} }
elsif ( $endpoint eq 'configAuth' ) { elsif ( $endpoint eq 'configAuth' ) {
WriteReadings( $hash, $decode_json, $endpoint ); WriteReadings( $hash, $decode_json, $endpoint );
} }
else { else {
return ::Log3( $name, 5, ::Log3( $name, 5,
"NUKIBridge ($name) - Rückgabe Path nicht korrekt: $json" ); "NUKIBridge ($name) - Rückgabe Path nicht korrekt: $json" );
} }
return;
} }
sub CGI() { sub CGI() {
@ -927,8 +1002,8 @@ sub CGI() {
my $hash; my $hash;
my $name; my $name;
while ( my ( $key, $value ) = each %{ $::modules{NUKIBridge}{defptr} } ) { while ( my ( $key, $value ) = each %{ $modules{NUKIBridge}{defptr} } ) {
$hash = $::modules{NUKIBridge}{defptr}{$key}; $hash = $modules{NUKIBridge}{defptr}{$key};
$name = $hash->{NAME}; $name = $hash->{NAME};
} }
@ -943,12 +1018,12 @@ sub CGI() {
"NUKIBridge WEBHOOK ($name) - empty message received" ); "NUKIBridge WEBHOOK ($name) - empty message received" );
return; return;
} }
elsif ( $json =~ m'HTTP/1.1 200 OK' ) { elsif ( $json =~ m{'HTTP/1.1 200 OK'}xms ) {
::Log3( $name, 4, ::Log3( $name, 4,
"NUKIBridge WEBHOOK ($name) - empty answer received" ); "NUKIBridge WEBHOOK ($name) - empty answer received" );
return; return;
} }
elsif ( $json !~ m/^[\[{].*[}\]]$/ ) { elsif ( $json !~ m{\A[\[{].*[}\]]\z}xms ) {
::Log3( $name, 3, ::Log3( $name, 3,
"NUKIBridge WEBHOOK ($name) - invalid json detected: $json" ); "NUKIBridge WEBHOOK ($name) - invalid json detected: $json" );
return ("NUKIBridge WEBHOOK ($name) - invalid json detected: $json"); return ("NUKIBridge WEBHOOK ($name) - invalid json detected: $json");
@ -957,7 +1032,7 @@ sub CGI() {
::Log3( $name, 5, ::Log3( $name, 5,
"NUKIBridge WEBHOOK ($name) - Webhook received with JSON: $json" ); "NUKIBridge WEBHOOK ($name) - Webhook received with JSON: $json" );
if ( $json =~ m/^\{.*\}$/ ) { if ( $json =~ m{\A\{.*\}\z}xms ) {
$hash->{WEBHOOK_COUNTER}++; $hash->{WEBHOOK_COUNTER}++;
$hash->{WEBHOOK_LAST} = ::TimeNow(); $hash->{WEBHOOK_LAST} = ::TimeNow();
@ -976,7 +1051,7 @@ sub CGI() {
"NUKIBridge WEBHOOK - received malformed request\n$request" ); "NUKIBridge WEBHOOK - received malformed request\n$request" );
} }
::return( 'text/plain; charset=utf-8', 'Call failure: ' . $request ); return ( 'text/plain; charset=utf-8', 'Call failure: ' . $request );
} }
sub WriteReadings { sub WriteReadings {
@ -986,12 +1061,6 @@ sub WriteReadings {
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $nukiId;
my $scanResults;
my %response_hash;
my $dname;
my $dhash;
::readingsBeginUpdate($hash); ::readingsBeginUpdate($hash);
if ( $endpoint eq 'configAuth' ) { if ( $endpoint eq 'configAuth' ) {
@ -1134,7 +1203,7 @@ sub getCallbackList {
for my $cb ( @{ $decode_json->{callbacks} } ) { for my $cb ( @{ $decode_json->{callbacks} } ) {
$aHref = "<a href=\"" $aHref = "<a href=\""
# . $::FW_httpheader->{host} # . main::$FW_httpheader->{host}
. "/fhem?cmd=set+" . "/fhem?cmd=set+"
. $name . $name
. "+callbackRemove+" . "+callbackRemove+"
@ -1245,24 +1314,25 @@ sub ParseJSON {
my $hash = shift; my $hash = shift;
my $buffer = shift; my $buffer = shift;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $open = 0; my $jsonopen = 0;
my $close = 0; my $jsonclose = 0;
my $msg = ''; my $msg = '';
my $tail = ''; my $tail = '';
if ($buffer) { if ($buffer) {
for my $c ( split //, $buffer ) { for my $c ( split //, $buffer ) {
if ( $open == $close if ( $jsonopen == $jsonclose
&& $open > 0 ) && $jsonopen > 0 )
{ {
$tail .= $c; $tail .= $c;
::Log3( $name, 5, ::Log3( $name, 5,
"NUKIBridge ($name) - $open == $close and $open > 0" ); "NUKIBridge ($name) - $jsonopen == $jsonclose and $jsonopen > 0"
);
} }
elsif ($open == $close elsif ($jsonopen == $jsonclose
&& $c ne '{' ) && $c ne '{' )
{ {
::Log3( $name, 5, ::Log3( $name, 5,
@ -1271,17 +1341,17 @@ sub ParseJSON {
} }
else { else {
if ( $c eq '{' ) { if ( $c eq '{' ) {
$open++; $jsonopen++;
} }
elsif ( $c eq '}' ) { elsif ( $c eq '}' ) {
$close++; $jsonclose++;
} }
$msg .= $c; $msg .= $c;
} }
} }
if ( $open != $close ) { if ( $jsonopen != $jsonclose ) {
$tail = $msg; $tail = $msg;
$msg = ''; $msg = '';
@ -1406,8 +1476,7 @@ sub BridgeDiscover_getAPIToken {
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $pullApiKeyMessage = my $pullApiKeyMessage =
'When issuing this API-call the bridge turns on its LED for 30 seconds. 'When issuing this API-call the bridge turns on its LED for 30 seconds. The button of the bridge has to be pressed within this timeframe. Otherwise the bridge returns a negative success and no token.';
The button of the bridge has to be pressed within this timeframe. Otherwise the bridge returns a negative success and no token.';
::readingsSingleUpdate( $hash, 'state', $pullApiKeyMessage, 1 ); ::readingsSingleUpdate( $hash, 'state', $pullApiKeyMessage, 1 );

187
lib/FHEM/Devices/Nuki/Device.pm
View File

@ -1,6 +1,6 @@
############################################################################### ###############################################################################
# #
# Developed with Kate # Developed with VSCodium
# #
# (c) 2016-2021 Copyright: Marko Oldenburg (fhemdevelopment at cooltux dot net) # (c) 2016-2021 Copyright: Marko Oldenburg (fhemdevelopment at cooltux dot net)
# All rights reserved # All rights reserved
@ -28,24 +28,34 @@ package FHEM::Devices::Nuki::Device;
use strict; use strict;
use warnings; use warnings;
use experimental qw( switch );
use FHEM::Meta; use FHEM::Meta;
use GPUtils qw(GP_Import);
BEGIN {
# Import from main context
GP_Import(
qw( init_done
defs
modules
)
);
}
# try to use JSON::MaybeXS wrapper # try to use JSON::MaybeXS wrapper
# for chance of better performance + open code # for chance of better performance + open code
eval { eval {
require JSON::MaybeXS; require JSON::MaybeXS;
import JSON::MaybeXS qw( decode_json encode_json ); import JSON::MaybeXS qw( decode_json encode_json );
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# try to use JSON wrapper # try to use JSON wrapper
# for chance of better performance # for chance of better performance
eval { eval {
# JSON preference order # JSON preference order
local $ENV{PERL_JSON_BACKEND} = local $ENV{PERL_JSON_BACKEND} =
'Cpanel::JSON::XS,JSON::XS,JSON::PP,JSON::backportPP' 'Cpanel::JSON::XS,JSON::XS,JSON::PP,JSON::backportPP'
@ -54,10 +64,7 @@ if ($@) {
require JSON; require JSON;
import JSON qw( decode_json encode_json ); import JSON qw( decode_json encode_json );
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# In rare cases, Cpanel::JSON::XS may # In rare cases, Cpanel::JSON::XS may
# be installed but JSON|JSON::MaybeXS not ... # be installed but JSON|JSON::MaybeXS not ...
@ -65,10 +72,7 @@ if ($@) {
require Cpanel::JSON::XS; require Cpanel::JSON::XS;
import Cpanel::JSON::XS qw(decode_json encode_json); import Cpanel::JSON::XS qw(decode_json encode_json);
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# In rare cases, JSON::XS may # In rare cases, JSON::XS may
# be installed but JSON not ... # be installed but JSON not ...
@ -76,10 +80,7 @@ if ($@) {
require JSON::XS; require JSON::XS;
import JSON::XS qw(decode_json encode_json); import JSON::XS qw(decode_json encode_json);
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# Fallback to built-in JSON which SHOULD # Fallback to built-in JSON which SHOULD
# be available since 5.014 ... # be available since 5.014 ...
@ -87,20 +88,17 @@ if ($@) {
require JSON::PP; require JSON::PP;
import JSON::PP qw(decode_json encode_json); import JSON::PP qw(decode_json encode_json);
1; 1;
}; } or do {
if ($@) {
$@ = undef;
# Fallback to JSON::backportPP in really rare cases # Fallback to JSON::backportPP in really rare cases
require JSON::backportPP; require JSON::backportPP;
import JSON::backportPP qw(decode_json encode_json); import JSON::backportPP qw(decode_json encode_json);
1; 1;
} };
} };
} };
} };
} };
######## Begin Device ######## Begin Device
@ -195,7 +193,9 @@ sub Define {
my $def = shift // return; my $def = shift // return;
return $@ unless ( FHEM::Meta::SetInternals($hash) ); return $@ unless ( FHEM::Meta::SetInternals($hash) );
use version 0.60; our $VERSION = FHEM::Meta::Get( $hash, 'version' );
$version = FHEM::Meta::Get( $hash, 'version' );
our $VERSION = $version;
my ( $name, undef, $nukiId, $deviceType ) = split( m{\s+}xms, $def ); my ( $name, undef, $nukiId, $deviceType ) = split( m{\s+}xms, $def );
return 'too few parameters: define <name> NUKIDevice <nukiId> <deviceType>' return 'too few parameters: define <name> NUKIDevice <nukiId> <deviceType>'
@ -227,11 +227,11 @@ sub Define {
$iodev = $hash->{IODev}->{NAME}; $iodev = $hash->{IODev}->{NAME};
$hash->{BRIDGEAPI} = $::defs{$iodev}->{BRIDGEAPI} $hash->{BRIDGEAPI} = $defs{$iodev}->{BRIDGEAPI}
if ( defined($iodev) if ( defined($iodev)
&& $iodev ); && $iodev );
my $d = $::modules{NUKIDevice}{defptr}{$nukiId}; my $d = $modules{NUKIDevice}{defptr}{$nukiId};
return return
'NUKIDevice device ' 'NUKIDevice device '
@ -250,11 +250,11 @@ sub Define {
::CommandAttr( undef, $name . ' model ' . $deviceTypes{$deviceType} ) ::CommandAttr( undef, $name . ' model ' . $deviceTypes{$deviceType} )
if ( ::AttrVal( $name, 'model', 'none' ) eq 'none' ); if ( ::AttrVal( $name, 'model', 'none' ) eq 'none' );
$::modules{NUKIDevice}{defptr}{$nukiId} = $hash; $modules{NUKIDevice}{defptr}{$nukiId} = $hash;
GetUpdate($hash) GetUpdate($hash)
if ( ::ReadingsVal( $name, 'success', 'none' ) eq 'none' if ( ::ReadingsVal( $name, 'success', 'none' ) eq 'none'
&& $::init_done ); && $init_done );
return; return;
} }
@ -266,7 +266,7 @@ sub Undef {
my $name = $hash->{NAME}; my $name = $hash->{NAME};
::Log3( $name, 3, "NUKIDevice ($name) - undefined with NukiId: $nukiId" ); ::Log3( $name, 3, "NUKIDevice ($name) - undefined with NukiId: $nukiId" );
delete( $::modules{NUKIDevice}{defptr}{$nukiId} ); delete( $modules{NUKIDevice}{defptr}{$nukiId} );
return; return;
} }
@ -277,7 +277,7 @@ sub Attr {
my $attrName = shift; my $attrName = shift;
my $attrVal = shift; my $attrVal = shift;
my $hash = $::defs{$name}; my $hash = $defs{$name};
my $token = $hash->{IODev}->{TOKEN}; my $token = $hash->{IODev}->{TOKEN};
if ( $attrName eq 'disable' ) { if ( $attrName eq 'disable' ) {
@ -330,17 +330,13 @@ sub Notify {
GetUpdate($hash) GetUpdate($hash)
if ( if (
( (
grep /^INITIALIZED$/, grep { /^INITIALIZED$/x } @{$events}
@{$events} or grep { /^REREADCFG$/x } @{$events}
or grep /^REREADCFG$/, or grep { /^MODIFIED.$name$/x } @{$events}
@{$events} or grep { /^DEFINED.$name$/x } @{$events}
or grep /^MODIFIED.$name$/,
@{$events}
or grep /^DEFINED.$name$/,
@{$events}
) )
&& $devname eq 'global' && $devname eq 'global'
&& $::init_done && $init_done
); );
return; return;
@ -427,7 +423,7 @@ sub Parse {
######################################### #########################################
####### Errorhandling ############# ####### Errorhandling #############
if ( $json !~ m/^[\[{].*[}\]]$/ ) { if ( $json !~ m{\A[\[{].*[}\]]\z}xms ) {
::Log3( $name, 3, "NUKIDevice ($name) - invalid json detected: $json" ); ::Log3( $name, 3, "NUKIDevice ($name) - invalid json detected: $json" );
return "NUKIDevice ($name) - invalid json detected: $json"; return "NUKIDevice ($name) - invalid json detected: $json";
} }
@ -449,18 +445,18 @@ sub Parse {
} }
my $nukiId = $decode_json->{nukiId}; my $nukiId = $decode_json->{nukiId};
if ( my $hash = $::modules{NUKIDevice}{defptr}{$nukiId} ) { if ( my $dhash = $modules{NUKIDevice}{defptr}{$nukiId} ) {
my $name = $hash->{NAME}; my $dname = $dhash->{NAME};
WriteReadings( $hash, $decode_json ); WriteReadings( $dhash, $decode_json );
::Log3( $name, 4, ::Log3( $dname, 4,
"NUKIDevice ($name) - find logical device: $hash->{NAME}" ); "NUKIDevice ($dname) - find logical device: $dhash->{NAME}" );
return $hash->{NAME}; return $dhash->{NAME};
} }
else { else {
::Log3( $name, 4, ::Log3( $dname, 4,
"NUKIDevice ($name) - autocreate new device " "NUKIDevice ($dname) - autocreate new device "
. ::makeDeviceName( $decode_json->{name} ) . ::makeDeviceName( $decode_json->{name} )
. " with nukiId $decode_json->{nukiId}, model $decode_json->{deviceType}" . " with nukiId $decode_json->{nukiId}, model $decode_json->{deviceType}"
); );
@ -472,16 +468,14 @@ sub Parse {
::Log3( $name, 5, "NUKIDevice ($name) - parse status message for $name" ); ::Log3( $name, 5, "NUKIDevice ($name) - parse status message for $name" );
WriteReadings( $hash, $decode_json ); return WriteReadings( $hash, $decode_json );
} }
sub WriteReadings { sub SmartlockState {
my $hash = shift;
my $decode_json = shift;
my $name = $hash->{NAME};
############################ ############################
#### Status des Smartlock #### Status des Smartlock
my $hash = shift;
my $decode_json = shift;
if ( defined( $hash->{helper}{lockAction} ) ) { if ( defined( $hash->{helper}{lockAction} ) ) {
my $state; my $state;
@ -527,6 +521,16 @@ sub WriteReadings {
delete $hash->{helper}{lockAction}; delete $hash->{helper}{lockAction};
} }
return;
}
sub WriteReadings {
my $hash = shift;
my $decode_json = shift;
my $name = $hash->{NAME};
SmartlockState();
::readingsBeginUpdate($hash); ::readingsBeginUpdate($hash);
my $t; my $t;
@ -555,36 +559,43 @@ sub WriteReadings {
&& $t ne 'doorsensorState' && $t ne 'doorsensorState'
&& $t ne 'doorsensorStateName' ); && $t ne 'doorsensorStateName' );
::readingsBulkUpdate( given ($t) {
$hash, $t, when ('state') {
( ::readingsBulkUpdate(
$v =~ m/^[0-9]$/ $hash, $t,
? $lockStates{$v}{ $hash->{DEVICETYPEID} } (
: $v $v =~ m{\A[0-9]\z}xms
) ? $lockStates{$v}->{ $hash->{DEVICETYPEID} }
) if ( $t eq 'state' ); : $v
)
::readingsBulkUpdate( $hash, $t, $modes{$v}{ $hash->{DEVICETYPEID} } ) );
if ( $t eq 'mode' ); }
when ('mode') {
::readingsBulkUpdate( $hash, $t, $deviceTypes{$v} ) ::readingsBulkUpdate( $hash, $t,
if ( $t eq 'deviceType' ); $modes{$v}{ $hash->{DEVICETYPEID} } );
}
::readingsBulkUpdate( $hash, $t, $doorsensorStates{$v} ) when ('deviceType') {
if ( $t eq 'doorsensorState' ); ::readingsBulkUpdate( $hash, $t, $deviceTypes{$v} );
}
::readingsBulkUpdate( $hash, $t, ( $v == 1 ? 'true' : 'false' ) ) when ('doorsensorState') {
if ( $t eq 'paired' ); ::readingsBulkUpdate( $hash, $t, $doorsensorStates{$v} );
}
::readingsBulkUpdate( $hash, $t, ( $v == 1 ? 'true' : 'false' ) ) when ('paired') {
if ( $t eq 'batteryCharging' ); ::readingsBulkUpdate( $hash, $t,
( $v == 1 ? 'true' : 'false' ) );
::readingsBulkUpdate( $hash, 'batteryState', }
( $v == 1 ? 'low' : 'ok' ) ) when ('batteryCharging') {
if ( $t eq 'batteryCritical' ); ::readingsBulkUpdate( $hash, $t,
( $v == 1 ? 'true' : 'false' ) );
::readingsBulkUpdate( $hash, 'batteryPercent', $v ) }
if ( $t eq 'batteryChargeState' ); when ('batteryCritical') {
::readingsBulkUpdate( $hash, 'batteryState',
( $v == 1 ? 'low' : 'ok' ) );
}
when ('batteryChargeState') {
::readingsBulkUpdate( $hash, 'batteryPercent', $v )
}
}
} }
::readingsEndUpdate( $hash, 1 ); ::readingsEndUpdate( $hash, 1 );