dev #25
@@ -1,6 +1,6 @@
 | 
			
		||||
###############################################################################
 | 
			
		||||
#
 | 
			
		||||
# Developed with Kate
 | 
			
		||||
# Developed with VSCodium
 | 
			
		||||
#
 | 
			
		||||
#  (c) 2016-2021 Copyright: Marko Oldenburg (fhemdevelopment at cooltux dot net)
 | 
			
		||||
#  All rights reserved
 | 
			
		||||
@@ -43,6 +43,14 @@ use warnings;
 | 
			
		||||
use FHEM::Meta;
 | 
			
		||||
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 Initialize {
 | 
			
		||||
@@ -68,7 +76,7 @@ sub Initialize {
 | 
			
		||||
      . 'webhookFWinstance:'
 | 
			
		||||
      . $webhookFWinstance . ' '
 | 
			
		||||
      . 'webhookHttpHostname '
 | 
			
		||||
      . $::readingFnAttributes;
 | 
			
		||||
      . $readingFnAttributes;
 | 
			
		||||
 | 
			
		||||
    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)
 | 
			
		||||
#  All rights reserved
 | 
			
		||||
@@ -32,11 +32,19 @@ use warnings;
 | 
			
		||||
use FHEM::Meta;
 | 
			
		||||
require FHEM::Devices::Nuki::Device;
 | 
			
		||||
 | 
			
		||||
use GPUtils qw(GP_Import);
 | 
			
		||||
 | 
			
		||||
BEGIN {
 | 
			
		||||
 | 
			
		||||
    # Import from main context
 | 
			
		||||
    GP_Import(qw( readingFnAttributes ));
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
main::LoadModule('NUKIBridge');
 | 
			
		||||
 | 
			
		||||
sub ::NUKIDevice_Initialize { goto &Initialize }
 | 
			
		||||
 | 
			
		||||
sub Initialize($) {
 | 
			
		||||
sub Initialize {
 | 
			
		||||
    my ($hash) = @_;
 | 
			
		||||
 | 
			
		||||
    $hash->{Match} = '^{.*}$';
 | 
			
		||||
@@ -52,7 +60,7 @@ sub Initialize($) {
 | 
			
		||||
        'IODev '
 | 
			
		||||
      . 'model:smartlock,opener,smartdoor,smartlock3 '
 | 
			
		||||
      . 'disable:1 '
 | 
			
		||||
      . $::readingFnAttributes;
 | 
			
		||||
      . $readingFnAttributes;
 | 
			
		||||
 | 
			
		||||
    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-05_12:10:05 7569 FHEM/74_NUKIDevice.pm
 | 
			
		||||
UPD 2021-12-05_12:14:27 40875 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:21:10 9332 FHEM/73_NUKIBridge.pm
 | 
			
		||||
UPD 2021-12-10_20:22:28 7681 FHEM/74_NUKIDevice.pm
 | 
			
		||||
UPD 2021-12-10_19:44:48 42801 lib/FHEM/Devices/Nuki/Bridge.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)
 | 
			
		||||
#  All rights reserved
 | 
			
		||||
@@ -39,25 +39,36 @@ package FHEM::Devices::Nuki::Bridge;
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use warnings;
 | 
			
		||||
use experimental qw( switch );
 | 
			
		||||
 | 
			
		||||
use FHEM::Meta;
 | 
			
		||||
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
 | 
			
		||||
#   for chance of better performance + open code
 | 
			
		||||
eval {
 | 
			
		||||
    require JSON::MaybeXS;
 | 
			
		||||
    import JSON::MaybeXS qw( decode_json encode_json );
 | 
			
		||||
    1;
 | 
			
		||||
};
 | 
			
		||||
 | 
			
		||||
if ($@) {
 | 
			
		||||
    $@ = undef;
 | 
			
		||||
} or do {
 | 
			
		||||
 | 
			
		||||
    # try to use JSON wrapper
 | 
			
		||||
    #   for chance of better performance
 | 
			
		||||
    eval {
 | 
			
		||||
 | 
			
		||||
        # JSON preference order
 | 
			
		||||
        local $ENV{PERL_JSON_BACKEND} =
 | 
			
		||||
          'Cpanel::JSON::XS,JSON::XS,JSON::PP,JSON::backportPP'
 | 
			
		||||
@@ -66,10 +77,7 @@ if ($@) {
 | 
			
		||||
        require JSON;
 | 
			
		||||
        import JSON qw( decode_json encode_json );
 | 
			
		||||
        1;
 | 
			
		||||
    };
 | 
			
		||||
 | 
			
		||||
    if ($@) {
 | 
			
		||||
        $@ = undef;
 | 
			
		||||
    } or do {
 | 
			
		||||
 | 
			
		||||
        # In rare cases, Cpanel::JSON::XS may
 | 
			
		||||
        #   be installed but JSON|JSON::MaybeXS not ...
 | 
			
		||||
@@ -77,10 +85,7 @@ if ($@) {
 | 
			
		||||
            require Cpanel::JSON::XS;
 | 
			
		||||
            import Cpanel::JSON::XS qw(decode_json encode_json);
 | 
			
		||||
            1;
 | 
			
		||||
        };
 | 
			
		||||
 | 
			
		||||
        if ($@) {
 | 
			
		||||
            $@ = undef;
 | 
			
		||||
        } or do {
 | 
			
		||||
 | 
			
		||||
            # In rare cases, JSON::XS may
 | 
			
		||||
            #   be installed but JSON not ...
 | 
			
		||||
@@ -88,10 +93,7 @@ if ($@) {
 | 
			
		||||
                require JSON::XS;
 | 
			
		||||
                import JSON::XS qw(decode_json encode_json);
 | 
			
		||||
                1;
 | 
			
		||||
            };
 | 
			
		||||
 | 
			
		||||
            if ($@) {
 | 
			
		||||
                $@ = undef;
 | 
			
		||||
            } or do {
 | 
			
		||||
 | 
			
		||||
                # Fallback to built-in JSON which SHOULD
 | 
			
		||||
                #   be available since 5.014 ...
 | 
			
		||||
@@ -99,20 +101,17 @@ if ($@) {
 | 
			
		||||
                    require JSON::PP;
 | 
			
		||||
                    import JSON::PP qw(decode_json encode_json);
 | 
			
		||||
                    1;
 | 
			
		||||
                };
 | 
			
		||||
 | 
			
		||||
                if ($@) {
 | 
			
		||||
                    $@ = undef;
 | 
			
		||||
                } or do {
 | 
			
		||||
 | 
			
		||||
                    # Fallback to JSON::backportPP in really rare cases
 | 
			
		||||
                    require JSON::backportPP;
 | 
			
		||||
                    import JSON::backportPP qw(decode_json encode_json);
 | 
			
		||||
                    1;
 | 
			
		||||
                }
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
                };
 | 
			
		||||
            };
 | 
			
		||||
        };
 | 
			
		||||
    };
 | 
			
		||||
};
 | 
			
		||||
 | 
			
		||||
######## Begin Bridge
 | 
			
		||||
 | 
			
		||||
@@ -138,11 +137,16 @@ my %lockActionsOpener = (
 | 
			
		||||
);
 | 
			
		||||
 | 
			
		||||
sub Define {
 | 
			
		||||
    use version 0.60;
 | 
			
		||||
 | 
			
		||||
    my $hash = shift;
 | 
			
		||||
    my $def  = shift // return;
 | 
			
		||||
    my $version;
 | 
			
		||||
 | 
			
		||||
    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 );
 | 
			
		||||
 | 
			
		||||
@@ -185,7 +189,7 @@ sub Define {
 | 
			
		||||
        $hash->{fhem}{infix} = $infix;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    $::modules{NUKIBridge}{defptr}{ $hash->{HOST} } = $hash;
 | 
			
		||||
    $modules{NUKIBridge}{defptr}{ $hash->{HOST} } = $hash;
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
@@ -201,7 +205,7 @@ sub Undef {
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    ::RemoveInternalTimer($hash);
 | 
			
		||||
    delete $::modules{NUKIBridge}{defptr}{ $hash->{HOST} };
 | 
			
		||||
    delete $modules{NUKIBridge}{defptr}{ $hash->{HOST} };
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
@@ -211,8 +215,9 @@ sub Attr {
 | 
			
		||||
    my $name     = shift;
 | 
			
		||||
    my $attrName = shift;
 | 
			
		||||
    my $attrVal  = shift;
 | 
			
		||||
    my $attrWebhookCheck;
 | 
			
		||||
 | 
			
		||||
    my $hash = $::defs{$name};
 | 
			
		||||
    my $hash = $defs{$name};
 | 
			
		||||
    my $orig = $attrVal;
 | 
			
		||||
 | 
			
		||||
    if ( $attrName eq 'disable' ) {
 | 
			
		||||
@@ -251,15 +256,30 @@ sub Attr {
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    ######################
 | 
			
		||||
    #### webhook #########
 | 
			
		||||
    $attrWebhookCheck = AttrWebhookCheck( $cmd, $name, $attrName, $attrVal );
 | 
			
		||||
 | 
			
		||||
    return (
 | 
			
		||||
"Invalid value for attribute $attrName: can only by FQDN or IPv4 or IPv6 address"
 | 
			
		||||
      )
 | 
			
		||||
      if ( $attrVal
 | 
			
		||||
        && $attrName eq 'webhookHttpHostname'
 | 
			
		||||
        && $attrVal !~ /^([A-Za-z_.0-9]+\.[A-Za-z_.0-9]+)|[0-9:]+$/ );
 | 
			
		||||
    return $attrWebhookCheck
 | 
			
		||||
      if ( defined($attrWebhookCheck) );
 | 
			
		||||
 | 
			
		||||
    return AttrWebhook( $hash, $cmd, $attrName, $attrVal );
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
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 (
 | 
			
		||||
"Invalid value for attribute $attrName: FHEMWEB instance $attrVal not existing"
 | 
			
		||||
@@ -267,17 +287,21 @@ sub Attr {
 | 
			
		||||
      if (
 | 
			
		||||
           $attrVal
 | 
			
		||||
        && $attrName eq 'webhookFWinstance'
 | 
			
		||||
        && ( !defined( $::defs{$attrVal} )
 | 
			
		||||
            || $::defs{$attrVal}{TYPE} ne 'FHEMWEB' )
 | 
			
		||||
        && ( !defined( $defs{$attrVal} )
 | 
			
		||||
            || $defs{$attrVal}{TYPE} ne 'FHEMWEB' )
 | 
			
		||||
      );
 | 
			
		||||
 | 
			
		||||
    return (
 | 
			
		||||
        "Invalid value for attribute $attrName: needs to be an integer value")
 | 
			
		||||
      if ( $attrVal
 | 
			
		||||
        && $attrName eq 'webhookPort'
 | 
			
		||||
        && $attrVal !~ /^\d+$/ );
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
    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 = (
 | 
			
		||||
              $attrName eq 'webhookHttpHostname' && defined($attrVal)
 | 
			
		||||
@@ -295,14 +319,8 @@ sub Attr {
 | 
			
		||||
          . ::AttrVal( $webhookFWinstance, 'webname', 'fhem' )
 | 
			
		||||
          . '/NUKIBridge' . '-'
 | 
			
		||||
          . $hash->{HOST};
 | 
			
		||||
        $hash->{WEBHOOK_PORT} = (
 | 
			
		||||
            $attrName eq 'webhookPort' ? $attrVal : ::AttrVal(
 | 
			
		||||
                $name, 'webhookPort',
 | 
			
		||||
                ::InternalVal( $webhookFWinstance, 'PORT', '' )
 | 
			
		||||
            )
 | 
			
		||||
        );
 | 
			
		||||
 | 
			
		||||
        $hash->{WEBHOOK_URL}     = '';
 | 
			
		||||
        $hash->{WEBHOOK_PORT} = ::InternalVal( $webhookFWinstance, 'PORT', '' );
 | 
			
		||||
        $hash->{WEBHOOK_URL}  = '';
 | 
			
		||||
        $hash->{WEBHOOK_COUNTER} = 0;
 | 
			
		||||
 | 
			
		||||
        if ( $webhookHttpHostname ne '' && $hash->{WEBHOOK_PORT} ne '' ) {
 | 
			
		||||
@@ -322,7 +340,7 @@ sub Attr {
 | 
			
		||||
 | 
			
		||||
            #             Write( $hash, 'callback/add', $url, undef, undef )
 | 
			
		||||
            Write( $hash, 'callback/add', '{"param":"' . $url . '"}' )
 | 
			
		||||
              if ($::init_done);
 | 
			
		||||
              if ($init_done);
 | 
			
		||||
            $hash->{WEBHOOK_REGISTER} = 'sent';
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
@@ -334,7 +352,6 @@ sub Attr {
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub Notify {
 | 
			
		||||
 | 
			
		||||
    my $hash = shift;
 | 
			
		||||
    my $dev  = shift // return;
 | 
			
		||||
    my $name = $hash->{NAME};
 | 
			
		||||
@@ -349,19 +366,15 @@ sub Notify {
 | 
			
		||||
    FirstRun($hash)
 | 
			
		||||
      if (
 | 
			
		||||
        (
 | 
			
		||||
            grep /^INITIALIZED$/,
 | 
			
		||||
            @{$events}
 | 
			
		||||
            or grep /^REREADCFG$/,
 | 
			
		||||
            @{$events}
 | 
			
		||||
            or grep /^MODIFIED.$name$/,
 | 
			
		||||
            @{$events}
 | 
			
		||||
            or grep /^DEFINED.$name$/,
 | 
			
		||||
            @{$events}
 | 
			
		||||
               grep { /^INITIALIZED$/x } @{$events}
 | 
			
		||||
            or grep { /^REREADCFG$/x } @{$events}
 | 
			
		||||
            or grep { /^MODIFIED.$name$/x } @{$events}
 | 
			
		||||
            or grep { /^DEFINED.$name$/x } @{$events}
 | 
			
		||||
        )
 | 
			
		||||
        && $hash->{HOST} ne 'discover'
 | 
			
		||||
        && $hash->{TOKEN} ne 'discover'
 | 
			
		||||
        && $devname eq 'global'
 | 
			
		||||
        && $::init_done
 | 
			
		||||
        && $init_done
 | 
			
		||||
      );
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
@@ -378,9 +391,9 @@ sub addExtension {
 | 
			
		||||
        "NUKIBridge ($name) - Registering NUKIBridge for webhook URI $url ..."
 | 
			
		||||
    );
 | 
			
		||||
 | 
			
		||||
    $::data{FWEXT}{$url}{deviceName} = $name;
 | 
			
		||||
    $::data{FWEXT}{$url}{FUNC}       = $func;
 | 
			
		||||
    $::data{FWEXT}{$url}{LINK}       = $link;
 | 
			
		||||
    $data{FWEXT}{$url}{deviceName} = $name;
 | 
			
		||||
    $data{FWEXT}{$url}{FUNC}       = $func;
 | 
			
		||||
    $data{FWEXT}{$url}{LINK}       = $link;
 | 
			
		||||
 | 
			
		||||
    return 1;
 | 
			
		||||
}
 | 
			
		||||
@@ -389,13 +402,13 @@ sub removeExtension {
 | 
			
		||||
    my $link = shift;
 | 
			
		||||
 | 
			
		||||
    my $url  = '/' . $link;
 | 
			
		||||
    my $name = $::data{FWEXT}{$url}{deviceName};
 | 
			
		||||
    my $name = $data{FWEXT}{$url}{deviceName};
 | 
			
		||||
 | 
			
		||||
    ::Log3( $name, 2,
 | 
			
		||||
        "NUKIBridge ($name) - Unregistering NUKIBridge for webhook URL $url..."
 | 
			
		||||
    ) if ( defined($name) );
 | 
			
		||||
 | 
			
		||||
    delete $::data{FWEXT}{$url};
 | 
			
		||||
    delete $data{FWEXT}{$url};
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
@@ -409,52 +422,59 @@ sub Set {
 | 
			
		||||
    my $endpoint;
 | 
			
		||||
    my $param;
 | 
			
		||||
 | 
			
		||||
    if ( lc($cmd) eq 'getdevicelist' ) {
 | 
			
		||||
        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) );
 | 
			
		||||
    $cmd = lc($cmd);
 | 
			
		||||
 | 
			
		||||
        $endpoint = 'reboot';
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( lc($cmd) eq 'clearlog' ) {
 | 
			
		||||
        return 'usage: clearLog' if ( defined($arg) );
 | 
			
		||||
    given ($cmd) {
 | 
			
		||||
        when ('getdevicelist') {
 | 
			
		||||
            return 'usage: getDeviceList' 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';
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( lc($cmd) eq 'factoryreset' ) {
 | 
			
		||||
        return 'usage: clearLog' if ( defined($arg) );
 | 
			
		||||
        when ('callbackremove') {
 | 
			
		||||
            return 'usage: callbackRemove'
 | 
			
		||||
              if ( split( m{\s+}xms, $arg ) > 1 );
 | 
			
		||||
            my $id = ( defined($arg) ? $arg : 0 );
 | 
			
		||||
            $endpoint = 'callback/remove';
 | 
			
		||||
            $param    = '{"param":"' . $id . '"}';
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        $endpoint = 'factoryReset';
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( lc($cmd) eq 'callbackremove' ) {
 | 
			
		||||
        return 'usage: callbackRemove' if ( split( m{\s+}xms, $arg ) > 1 );
 | 
			
		||||
        when ('configauth') {
 | 
			
		||||
            return 'usage: configAuth' if ( split( m{\s+}xms, $arg ) > 1 );
 | 
			
		||||
            $endpoint = 'clearlog';
 | 
			
		||||
            my $configAuth = 'enable=' . ( $arg eq 'enable' ? 1 : 0 );
 | 
			
		||||
            $endpoint = 'configAuth';
 | 
			
		||||
            $param    = '{"param":"' . $configAuth . '"}';
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        my $id = ( defined($arg) ? $arg : 0 );
 | 
			
		||||
        $endpoint = 'callback/remove';
 | 
			
		||||
        $param    = '{"param":"' . $id . '"}';
 | 
			
		||||
    }
 | 
			
		||||
    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 .=
 | 
			
		||||
        default {
 | 
			
		||||
            my $list = '';
 | 
			
		||||
            $list .= 'info:noArg getDeviceList:noArg ';
 | 
			
		||||
            $list .=
 | 
			
		||||
'clearLog:noArg fwUpdate:noArg reboot:noArg factoryReset:noArg configAuth:enable,disable'
 | 
			
		||||
          if ( ::ReadingsVal( $name, 'bridgeType', 'Software' ) eq 'Hardware' );
 | 
			
		||||
        return ( 'Unknown argument ' . $cmd . ', choose one of ' . $list );
 | 
			
		||||
              if ( ::ReadingsVal( $name, 'bridgeType', 'Software' ) eq
 | 
			
		||||
                'Hardware' );
 | 
			
		||||
            return ( 'Unknown argument ' . $cmd . ', choose one of ' . $list );
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    Write( $hash, $endpoint, $param )
 | 
			
		||||
@@ -471,23 +491,25 @@ sub Get {
 | 
			
		||||
 | 
			
		||||
    my $endpoint;
 | 
			
		||||
 | 
			
		||||
    if ( lc($cmd) eq 'logfile' ) {
 | 
			
		||||
        return 'usage: logFile' if ( defined($arg) );
 | 
			
		||||
    $cmd = lc($cmd);
 | 
			
		||||
    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';
 | 
			
		||||
    }
 | 
			
		||||
    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 'Unknown argument ' . $cmd . ', choose one of ' . $list;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return Write( $hash, $endpoint, undef );
 | 
			
		||||
@@ -533,8 +555,9 @@ sub Write {
 | 
			
		||||
    my $hash     = shift;
 | 
			
		||||
    my $endpoint = shift // return;
 | 
			
		||||
    my $json     = shift;
 | 
			
		||||
    my $decode_json;
 | 
			
		||||
 | 
			
		||||
    my $decode_json = eval { decode_json($json) }
 | 
			
		||||
    $decode_json = eval { decode_json($json) }
 | 
			
		||||
      if ( defined($json) );
 | 
			
		||||
 | 
			
		||||
    my $nukiId     = $decode_json->{nukiId}     // undef;
 | 
			
		||||
@@ -658,34 +681,11 @@ sub BridgeCall {
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub Distribution {
 | 
			
		||||
sub DistributionErrHandle1 {
 | 
			
		||||
    my $hash  = shift;
 | 
			
		||||
    my $param = shift;
 | 
			
		||||
    my $err   = shift;
 | 
			
		||||
    my $json  = shift;
 | 
			
		||||
 | 
			
		||||
    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);
 | 
			
		||||
    my $name  = $hash->{NAME};
 | 
			
		||||
 | 
			
		||||
    if ( defined($err) ) {
 | 
			
		||||
        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 )
 | 
			
		||||
        && exists( $param->{code} )
 | 
			
		||||
        && $param->{code} != 200 )
 | 
			
		||||
@@ -758,6 +770,14 @@ sub Distribution {
 | 
			
		||||
              . ' without any data after requesting' );
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub DistributionErrHandle3 {
 | 
			
		||||
    my ( $hash, $err, $dhash, $param, $json ) = @_;
 | 
			
		||||
 | 
			
		||||
    my $name = $hash->{NAME};
 | 
			
		||||
 | 
			
		||||
    if ( ( $json =~ /Error/i )
 | 
			
		||||
        && exists( $param->{code} ) )
 | 
			
		||||
    {
 | 
			
		||||
@@ -781,6 +801,49 @@ sub Distribution {
 | 
			
		||||
 | 
			
		||||
        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}
 | 
			
		||||
      if ( defined( $hash->{helper}->{lastDeviceAction} )
 | 
			
		||||
@@ -825,6 +888,70 @@ sub Distribution {
 | 
			
		||||
    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 {
 | 
			
		||||
    my $hash     = shift;
 | 
			
		||||
    my $json     = shift;
 | 
			
		||||
@@ -837,11 +964,11 @@ sub ResponseProcessing {
 | 
			
		||||
        ::Log3( $name, 3, "NUKIBridge ($name) - empty answer received" );
 | 
			
		||||
        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" );
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( $json !~ m/^[\[{].*[}\]]$/ ) {
 | 
			
		||||
    elsif ( $json !~ m{^[\[{].*[}\]]$}xms ) {
 | 
			
		||||
        ::Log3( $name, 3, "NUKIBridge ($name) - invalid json detected: $json" );
 | 
			
		||||
        return ("NUKIBridge ($name) - invalid json detected: $json");
 | 
			
		||||
    }
 | 
			
		||||
@@ -855,70 +982,18 @@ sub ResponseProcessing {
 | 
			
		||||
    if (   $endpoint eq 'list'
 | 
			
		||||
        || $endpoint eq 'info' )
 | 
			
		||||
    {
 | 
			
		||||
        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 ( $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;
 | 
			
		||||
        HandlingListInfo( $hash, $json, $decode_json, $endpoint );
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( $endpoint eq 'configAuth' ) {
 | 
			
		||||
        WriteReadings( $hash, $decode_json, $endpoint );
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
 | 
			
		||||
        return ::Log3( $name, 5,
 | 
			
		||||
        ::Log3( $name, 5,
 | 
			
		||||
            "NUKIBridge ($name) - Rückgabe Path nicht korrekt: $json" );
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub CGI() {
 | 
			
		||||
@@ -927,8 +1002,8 @@ sub CGI() {
 | 
			
		||||
    my $hash;
 | 
			
		||||
    my $name;
 | 
			
		||||
 | 
			
		||||
    while ( my ( $key, $value ) = each %{ $::modules{NUKIBridge}{defptr} } ) {
 | 
			
		||||
        $hash = $::modules{NUKIBridge}{defptr}{$key};
 | 
			
		||||
    while ( my ( $key, $value ) = each %{ $modules{NUKIBridge}{defptr} } ) {
 | 
			
		||||
        $hash = $modules{NUKIBridge}{defptr}{$key};
 | 
			
		||||
        $name = $hash->{NAME};
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
@@ -943,12 +1018,12 @@ sub CGI() {
 | 
			
		||||
            "NUKIBridge WEBHOOK ($name) - empty message received" );
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( $json =~ m'HTTP/1.1 200 OK' ) {
 | 
			
		||||
    elsif ( $json =~ m{'HTTP/1.1 200 OK'}xms ) {
 | 
			
		||||
        ::Log3( $name, 4,
 | 
			
		||||
            "NUKIBridge WEBHOOK ($name) - empty answer received" );
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( $json !~ m/^[\[{].*[}\]]$/ ) {
 | 
			
		||||
    elsif ( $json !~ m{\A[\[{].*[}\]]\z}xms ) {
 | 
			
		||||
        ::Log3( $name, 3,
 | 
			
		||||
            "NUKIBridge WEBHOOK ($name) - invalid json detected: $json" );
 | 
			
		||||
        return ("NUKIBridge WEBHOOK ($name) - invalid json detected: $json");
 | 
			
		||||
@@ -957,7 +1032,7 @@ sub CGI() {
 | 
			
		||||
    ::Log3( $name, 5,
 | 
			
		||||
        "NUKIBridge WEBHOOK ($name) - Webhook received with JSON: $json" );
 | 
			
		||||
 | 
			
		||||
    if ( $json =~ m/^\{.*\}$/ ) {
 | 
			
		||||
    if ( $json =~ m{\A\{.*\}\z}xms ) {
 | 
			
		||||
        $hash->{WEBHOOK_COUNTER}++;
 | 
			
		||||
        $hash->{WEBHOOK_LAST} = ::TimeNow();
 | 
			
		||||
 | 
			
		||||
@@ -976,7 +1051,7 @@ sub CGI() {
 | 
			
		||||
            "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 {
 | 
			
		||||
@@ -986,12 +1061,6 @@ sub WriteReadings {
 | 
			
		||||
 | 
			
		||||
    my $name = $hash->{NAME};
 | 
			
		||||
 | 
			
		||||
    my $nukiId;
 | 
			
		||||
    my $scanResults;
 | 
			
		||||
    my %response_hash;
 | 
			
		||||
    my $dname;
 | 
			
		||||
    my $dhash;
 | 
			
		||||
 | 
			
		||||
    ::readingsBeginUpdate($hash);
 | 
			
		||||
 | 
			
		||||
    if ( $endpoint eq 'configAuth' ) {
 | 
			
		||||
@@ -1134,7 +1203,7 @@ sub getCallbackList {
 | 
			
		||||
                for my $cb ( @{ $decode_json->{callbacks} } ) {
 | 
			
		||||
                    $aHref = "<a href=\""
 | 
			
		||||
 | 
			
		||||
                      #                       . $::FW_httpheader->{host}
 | 
			
		||||
                      #                       . main::$FW_httpheader->{host}
 | 
			
		||||
                      . "/fhem?cmd=set+"
 | 
			
		||||
                      . $name
 | 
			
		||||
                      . "+callbackRemove+"
 | 
			
		||||
@@ -1245,24 +1314,25 @@ sub ParseJSON {
 | 
			
		||||
    my $hash   = shift;
 | 
			
		||||
    my $buffer = shift;
 | 
			
		||||
 | 
			
		||||
    my $name  = $hash->{NAME};
 | 
			
		||||
    my $open  = 0;
 | 
			
		||||
    my $close = 0;
 | 
			
		||||
    my $msg   = '';
 | 
			
		||||
    my $tail  = '';
 | 
			
		||||
    my $name      = $hash->{NAME};
 | 
			
		||||
    my $jsonopen  = 0;
 | 
			
		||||
    my $jsonclose = 0;
 | 
			
		||||
    my $msg       = '';
 | 
			
		||||
    my $tail      = '';
 | 
			
		||||
 | 
			
		||||
    if ($buffer) {
 | 
			
		||||
        for my $c ( split //, $buffer ) {
 | 
			
		||||
 | 
			
		||||
            if (   $open == $close
 | 
			
		||||
                && $open > 0 )
 | 
			
		||||
            if (   $jsonopen == $jsonclose
 | 
			
		||||
                && $jsonopen > 0 )
 | 
			
		||||
            {
 | 
			
		||||
                $tail .= $c;
 | 
			
		||||
                ::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 '{' )
 | 
			
		||||
            {
 | 
			
		||||
                ::Log3( $name, 5,
 | 
			
		||||
@@ -1271,17 +1341,17 @@ sub ParseJSON {
 | 
			
		||||
            }
 | 
			
		||||
            else {
 | 
			
		||||
                if ( $c eq '{' ) {
 | 
			
		||||
                    $open++;
 | 
			
		||||
                    $jsonopen++;
 | 
			
		||||
                }
 | 
			
		||||
                elsif ( $c eq '}' ) {
 | 
			
		||||
                    $close++;
 | 
			
		||||
                    $jsonclose++;
 | 
			
		||||
                }
 | 
			
		||||
 | 
			
		||||
                $msg .= $c;
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        if ( $open != $close ) {
 | 
			
		||||
        if ( $jsonopen != $jsonclose ) {
 | 
			
		||||
 | 
			
		||||
            $tail = $msg;
 | 
			
		||||
            $msg  = '';
 | 
			
		||||
@@ -1406,8 +1476,7 @@ sub BridgeDiscover_getAPIToken {
 | 
			
		||||
    my $name        = $hash->{NAME};
 | 
			
		||||
 | 
			
		||||
    my $pullApiKeyMessage =
 | 
			
		||||
      '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.';
 | 
			
		||||
'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.';
 | 
			
		||||
 | 
			
		||||
    ::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)
 | 
			
		||||
#  All rights reserved
 | 
			
		||||
@@ -28,24 +28,34 @@ package FHEM::Devices::Nuki::Device;
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use warnings;
 | 
			
		||||
use experimental qw( switch );
 | 
			
		||||
 | 
			
		||||
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
 | 
			
		||||
#   for chance of better performance + open code
 | 
			
		||||
eval {
 | 
			
		||||
    require JSON::MaybeXS;
 | 
			
		||||
    import JSON::MaybeXS qw( decode_json encode_json );
 | 
			
		||||
    1;
 | 
			
		||||
};
 | 
			
		||||
 | 
			
		||||
if ($@) {
 | 
			
		||||
    $@ = undef;
 | 
			
		||||
} or do {
 | 
			
		||||
 | 
			
		||||
    # try to use JSON wrapper
 | 
			
		||||
    #   for chance of better performance
 | 
			
		||||
    eval {
 | 
			
		||||
 | 
			
		||||
        # JSON preference order
 | 
			
		||||
        local $ENV{PERL_JSON_BACKEND} =
 | 
			
		||||
          'Cpanel::JSON::XS,JSON::XS,JSON::PP,JSON::backportPP'
 | 
			
		||||
@@ -54,10 +64,7 @@ if ($@) {
 | 
			
		||||
        require JSON;
 | 
			
		||||
        import JSON qw( decode_json encode_json );
 | 
			
		||||
        1;
 | 
			
		||||
    };
 | 
			
		||||
 | 
			
		||||
    if ($@) {
 | 
			
		||||
        $@ = undef;
 | 
			
		||||
    } or do {
 | 
			
		||||
 | 
			
		||||
        # In rare cases, Cpanel::JSON::XS may
 | 
			
		||||
        #   be installed but JSON|JSON::MaybeXS not ...
 | 
			
		||||
@@ -65,10 +72,7 @@ if ($@) {
 | 
			
		||||
            require Cpanel::JSON::XS;
 | 
			
		||||
            import Cpanel::JSON::XS qw(decode_json encode_json);
 | 
			
		||||
            1;
 | 
			
		||||
        };
 | 
			
		||||
 | 
			
		||||
        if ($@) {
 | 
			
		||||
            $@ = undef;
 | 
			
		||||
        } or do {
 | 
			
		||||
 | 
			
		||||
            # In rare cases, JSON::XS may
 | 
			
		||||
            #   be installed but JSON not ...
 | 
			
		||||
@@ -76,10 +80,7 @@ if ($@) {
 | 
			
		||||
                require JSON::XS;
 | 
			
		||||
                import JSON::XS qw(decode_json encode_json);
 | 
			
		||||
                1;
 | 
			
		||||
            };
 | 
			
		||||
 | 
			
		||||
            if ($@) {
 | 
			
		||||
                $@ = undef;
 | 
			
		||||
            } or do {
 | 
			
		||||
 | 
			
		||||
                # Fallback to built-in JSON which SHOULD
 | 
			
		||||
                #   be available since 5.014 ...
 | 
			
		||||
@@ -87,20 +88,17 @@ if ($@) {
 | 
			
		||||
                    require JSON::PP;
 | 
			
		||||
                    import JSON::PP qw(decode_json encode_json);
 | 
			
		||||
                    1;
 | 
			
		||||
                };
 | 
			
		||||
 | 
			
		||||
                if ($@) {
 | 
			
		||||
                    $@ = undef;
 | 
			
		||||
                } or do {
 | 
			
		||||
 | 
			
		||||
                    # Fallback to JSON::backportPP in really rare cases
 | 
			
		||||
                    require JSON::backportPP;
 | 
			
		||||
                    import JSON::backportPP qw(decode_json encode_json);
 | 
			
		||||
                    1;
 | 
			
		||||
                }
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
                };
 | 
			
		||||
            };
 | 
			
		||||
        };
 | 
			
		||||
    };
 | 
			
		||||
};
 | 
			
		||||
 | 
			
		||||
######## Begin Device
 | 
			
		||||
 | 
			
		||||
@@ -195,7 +193,9 @@ sub Define {
 | 
			
		||||
    my $def  = shift // return;
 | 
			
		||||
 | 
			
		||||
    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 );
 | 
			
		||||
    return 'too few parameters: define <name> NUKIDevice <nukiId> <deviceType>'
 | 
			
		||||
@@ -227,11 +227,11 @@ sub Define {
 | 
			
		||||
 | 
			
		||||
    $iodev = $hash->{IODev}->{NAME};
 | 
			
		||||
 | 
			
		||||
    $hash->{BRIDGEAPI} = $::defs{$iodev}->{BRIDGEAPI}
 | 
			
		||||
    $hash->{BRIDGEAPI} = $defs{$iodev}->{BRIDGEAPI}
 | 
			
		||||
      if ( defined($iodev)
 | 
			
		||||
        && $iodev );
 | 
			
		||||
 | 
			
		||||
    my $d = $::modules{NUKIDevice}{defptr}{$nukiId};
 | 
			
		||||
    my $d = $modules{NUKIDevice}{defptr}{$nukiId};
 | 
			
		||||
 | 
			
		||||
    return
 | 
			
		||||
        'NUKIDevice device '
 | 
			
		||||
@@ -250,11 +250,11 @@ sub Define {
 | 
			
		||||
    ::CommandAttr( undef, $name . ' model ' . $deviceTypes{$deviceType} )
 | 
			
		||||
      if ( ::AttrVal( $name, 'model', 'none' ) eq 'none' );
 | 
			
		||||
 | 
			
		||||
    $::modules{NUKIDevice}{defptr}{$nukiId} = $hash;
 | 
			
		||||
    $modules{NUKIDevice}{defptr}{$nukiId} = $hash;
 | 
			
		||||
 | 
			
		||||
    GetUpdate($hash)
 | 
			
		||||
      if ( ::ReadingsVal( $name, 'success', 'none' ) eq 'none'
 | 
			
		||||
        && $::init_done );
 | 
			
		||||
        && $init_done );
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
@@ -266,7 +266,7 @@ sub Undef {
 | 
			
		||||
    my $name   = $hash->{NAME};
 | 
			
		||||
 | 
			
		||||
    ::Log3( $name, 3, "NUKIDevice ($name) - undefined with NukiId: $nukiId" );
 | 
			
		||||
    delete( $::modules{NUKIDevice}{defptr}{$nukiId} );
 | 
			
		||||
    delete( $modules{NUKIDevice}{defptr}{$nukiId} );
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
@@ -277,7 +277,7 @@ sub Attr {
 | 
			
		||||
    my $attrName = shift;
 | 
			
		||||
    my $attrVal  = shift;
 | 
			
		||||
 | 
			
		||||
    my $hash  = $::defs{$name};
 | 
			
		||||
    my $hash  = $defs{$name};
 | 
			
		||||
    my $token = $hash->{IODev}->{TOKEN};
 | 
			
		||||
 | 
			
		||||
    if ( $attrName eq 'disable' ) {
 | 
			
		||||
@@ -330,17 +330,13 @@ sub Notify {
 | 
			
		||||
    GetUpdate($hash)
 | 
			
		||||
      if (
 | 
			
		||||
        (
 | 
			
		||||
            grep /^INITIALIZED$/,
 | 
			
		||||
            @{$events}
 | 
			
		||||
            or grep /^REREADCFG$/,
 | 
			
		||||
            @{$events}
 | 
			
		||||
            or grep /^MODIFIED.$name$/,
 | 
			
		||||
            @{$events}
 | 
			
		||||
            or grep /^DEFINED.$name$/,
 | 
			
		||||
            @{$events}
 | 
			
		||||
               grep { /^INITIALIZED$/x } @{$events}
 | 
			
		||||
            or grep { /^REREADCFG$/x } @{$events}
 | 
			
		||||
            or grep { /^MODIFIED.$name$/x } @{$events}
 | 
			
		||||
            or grep { /^DEFINED.$name$/x } @{$events}
 | 
			
		||||
        )
 | 
			
		||||
        && $devname eq 'global'
 | 
			
		||||
        && $::init_done
 | 
			
		||||
        && $init_done
 | 
			
		||||
      );
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
@@ -427,7 +423,7 @@ sub Parse {
 | 
			
		||||
    #########################################
 | 
			
		||||
    ####### Errorhandling #############
 | 
			
		||||
 | 
			
		||||
    if ( $json !~ m/^[\[{].*[}\]]$/ ) {
 | 
			
		||||
    if ( $json !~ m{\A[\[{].*[}\]]\z}xms ) {
 | 
			
		||||
        ::Log3( $name, 3, "NUKIDevice ($name) - invalid json detected: $json" );
 | 
			
		||||
        return "NUKIDevice ($name) - invalid json detected: $json";
 | 
			
		||||
    }
 | 
			
		||||
@@ -449,18 +445,18 @@ sub Parse {
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my $nukiId = $decode_json->{nukiId};
 | 
			
		||||
    if ( my $hash = $::modules{NUKIDevice}{defptr}{$nukiId} ) {
 | 
			
		||||
        my $name = $hash->{NAME};
 | 
			
		||||
    if ( my $dhash = $modules{NUKIDevice}{defptr}{$nukiId} ) {
 | 
			
		||||
        my $dname = $dhash->{NAME};
 | 
			
		||||
 | 
			
		||||
        WriteReadings( $hash, $decode_json );
 | 
			
		||||
        ::Log3( $name, 4,
 | 
			
		||||
            "NUKIDevice ($name) - find logical device: $hash->{NAME}" );
 | 
			
		||||
        WriteReadings( $dhash, $decode_json );
 | 
			
		||||
        ::Log3( $dname, 4,
 | 
			
		||||
            "NUKIDevice ($dname) - find logical device: $dhash->{NAME}" );
 | 
			
		||||
 | 
			
		||||
        return $hash->{NAME};
 | 
			
		||||
        return $dhash->{NAME};
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        ::Log3( $name, 4,
 | 
			
		||||
                "NUKIDevice ($name) - autocreate new device "
 | 
			
		||||
        ::Log3( $dname, 4,
 | 
			
		||||
                "NUKIDevice ($dname) - autocreate new device "
 | 
			
		||||
              . ::makeDeviceName( $decode_json->{name} )
 | 
			
		||||
              . " 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" );
 | 
			
		||||
 | 
			
		||||
    WriteReadings( $hash, $decode_json );
 | 
			
		||||
    return WriteReadings( $hash, $decode_json );
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub WriteReadings {
 | 
			
		||||
    my $hash        = shift;
 | 
			
		||||
    my $decode_json = shift;
 | 
			
		||||
    my $name        = $hash->{NAME};
 | 
			
		||||
 | 
			
		||||
sub SmartlockState {
 | 
			
		||||
    ############################
 | 
			
		||||
    #### Status des Smartlock
 | 
			
		||||
    my $hash        = shift;
 | 
			
		||||
    my $decode_json = shift;
 | 
			
		||||
 | 
			
		||||
    if ( defined( $hash->{helper}{lockAction} ) ) {
 | 
			
		||||
        my $state;
 | 
			
		||||
@@ -527,6 +521,16 @@ sub WriteReadings {
 | 
			
		||||
        delete $hash->{helper}{lockAction};
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub WriteReadings {
 | 
			
		||||
    my $hash        = shift;
 | 
			
		||||
    my $decode_json = shift;
 | 
			
		||||
    my $name        = $hash->{NAME};
 | 
			
		||||
 | 
			
		||||
    SmartlockState();
 | 
			
		||||
 | 
			
		||||
    ::readingsBeginUpdate($hash);
 | 
			
		||||
 | 
			
		||||
    my $t;
 | 
			
		||||
@@ -555,36 +559,43 @@ sub WriteReadings {
 | 
			
		||||
            && $t ne 'doorsensorState'
 | 
			
		||||
            && $t ne 'doorsensorStateName' );
 | 
			
		||||
 | 
			
		||||
        ::readingsBulkUpdate(
 | 
			
		||||
            $hash, $t,
 | 
			
		||||
            (
 | 
			
		||||
                  $v =~ m/^[0-9]$/
 | 
			
		||||
                ? $lockStates{$v}{ $hash->{DEVICETYPEID} }
 | 
			
		||||
                : $v
 | 
			
		||||
            )
 | 
			
		||||
        ) if ( $t eq 'state' );
 | 
			
		||||
 | 
			
		||||
        ::readingsBulkUpdate( $hash, $t, $modes{$v}{ $hash->{DEVICETYPEID} } )
 | 
			
		||||
          if ( $t eq 'mode' );
 | 
			
		||||
 | 
			
		||||
        ::readingsBulkUpdate( $hash, $t, $deviceTypes{$v} )
 | 
			
		||||
          if ( $t eq 'deviceType' );
 | 
			
		||||
 | 
			
		||||
        ::readingsBulkUpdate( $hash, $t, $doorsensorStates{$v} )
 | 
			
		||||
          if ( $t eq 'doorsensorState' );
 | 
			
		||||
 | 
			
		||||
        ::readingsBulkUpdate( $hash, $t, ( $v == 1 ? 'true' : 'false' ) )
 | 
			
		||||
          if ( $t eq 'paired' );
 | 
			
		||||
 | 
			
		||||
        ::readingsBulkUpdate( $hash, $t, ( $v == 1 ? 'true' : 'false' ) )
 | 
			
		||||
          if ( $t eq 'batteryCharging' );
 | 
			
		||||
 | 
			
		||||
        ::readingsBulkUpdate( $hash, 'batteryState',
 | 
			
		||||
            ( $v == 1 ? 'low' : 'ok' ) )
 | 
			
		||||
          if ( $t eq 'batteryCritical' );
 | 
			
		||||
 | 
			
		||||
        ::readingsBulkUpdate( $hash, 'batteryPercent', $v )
 | 
			
		||||
          if ( $t eq 'batteryChargeState' );
 | 
			
		||||
        given ($t) {
 | 
			
		||||
            when ('state') {
 | 
			
		||||
                ::readingsBulkUpdate(
 | 
			
		||||
                    $hash, $t,
 | 
			
		||||
                    (
 | 
			
		||||
                          $v =~ m{\A[0-9]\z}xms
 | 
			
		||||
                        ? $lockStates{$v}->{ $hash->{DEVICETYPEID} }
 | 
			
		||||
                        : $v
 | 
			
		||||
                    )
 | 
			
		||||
                );
 | 
			
		||||
            }
 | 
			
		||||
            when ('mode') {
 | 
			
		||||
                ::readingsBulkUpdate( $hash, $t,
 | 
			
		||||
                    $modes{$v}{ $hash->{DEVICETYPEID} } );
 | 
			
		||||
            }
 | 
			
		||||
            when ('deviceType') {
 | 
			
		||||
                ::readingsBulkUpdate( $hash, $t, $deviceTypes{$v} );
 | 
			
		||||
            }
 | 
			
		||||
            when ('doorsensorState') {
 | 
			
		||||
                ::readingsBulkUpdate( $hash, $t, $doorsensorStates{$v} );
 | 
			
		||||
            }
 | 
			
		||||
            when ('paired') {
 | 
			
		||||
                ::readingsBulkUpdate( $hash, $t,
 | 
			
		||||
                    ( $v == 1 ? 'true' : 'false' ) );
 | 
			
		||||
            }
 | 
			
		||||
            when ('batteryCharging') {
 | 
			
		||||
                ::readingsBulkUpdate( $hash, $t,
 | 
			
		||||
                    ( $v == 1 ? 'true' : 'false' ) );
 | 
			
		||||
            }
 | 
			
		||||
            when ('batteryCritical') {
 | 
			
		||||
                ::readingsBulkUpdate( $hash, 'batteryState',
 | 
			
		||||
                    ( $v == 1 ? 'low' : 'ok' ) );
 | 
			
		||||
            }
 | 
			
		||||
            when ('batteryChargeState') {
 | 
			
		||||
                ::readingsBulkUpdate( $hash, 'batteryPercent', $v )
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    ::readingsEndUpdate( $hash, 1 );
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user