dev #25
@ -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 );
|
||||||
}
|
}
|
||||||
|
|||||||
@ -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 );
|
||||||
}
|
}
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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 );
|
||||||
|
|
||||||
|
|||||||
@ -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 );
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user