devel #49
@ -62,16 +62,15 @@ use warnings;
|
|||||||
use POSIX;
|
use POSIX;
|
||||||
use FHEM::Meta;
|
use FHEM::Meta;
|
||||||
|
|
||||||
use Data::Dumper;
|
|
||||||
|
|
||||||
use HttpUtils;
|
use HttpUtils;
|
||||||
|
|
||||||
my $missingModul = '';
|
my $missingModul = '';
|
||||||
eval "use Encode qw(encode encode_utf8 decode_utf8);1"
|
eval { use Encode qw /encode_utf8 decode_utf8/; 1 }
|
||||||
or $missingModul .= "Encode ";
|
or $missingModul .= "Encode ";
|
||||||
|
|
||||||
# eval "use JSON;1" || $missingModul .= 'JSON ';
|
# eval "use JSON;1" || $missingModul .= 'JSON ';
|
||||||
eval "use IO::Socket::SSL;1" or $missingModul .= 'IO::Socket::SSL ';
|
eval { use IO::Socket::SSL; 1 }
|
||||||
|
or $missingModul .= 'IO::Socket::SSL ';
|
||||||
|
|
||||||
# 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
|
||||||
@ -79,15 +78,11 @@ 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'
|
||||||
@ -96,10 +91,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 ...
|
||||||
@ -107,10 +99,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 ...
|
||||||
@ -118,10 +107,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 ...
|
||||||
@ -129,20 +115,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;
|
||||||
}
|
};
|
||||||
}
|
};
|
||||||
}
|
};
|
||||||
}
|
};
|
||||||
}
|
};
|
||||||
|
|
||||||
## Import der FHEM Funktionen
|
## Import der FHEM Funktionen
|
||||||
#-- Run before package compilation
|
#-- Run before package compilation
|
||||||
@ -808,8 +791,6 @@ sub ResponseProcessing {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# print Dumper $decode_json;
|
|
||||||
|
|
||||||
if ( defined( $decode_json->{data} )
|
if ( defined( $decode_json->{data} )
|
||||||
&& $decode_json->{data}
|
&& $decode_json->{data}
|
||||||
&& ref( $decode_json->{data} ) eq 'HASH'
|
&& ref( $decode_json->{data} ) eq 'HASH'
|
||||||
@ -892,6 +873,42 @@ qq{GardenaSmartBridge ($name) - execute parse json asynchronously (PID="$pid")}
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub ResponseProcessingFinalFromSubProcessing {
|
||||||
|
my $hash = shift;
|
||||||
|
my $response = shift;
|
||||||
|
|
||||||
|
my $name = $hash->{NAME};
|
||||||
|
|
||||||
|
my @response = split '\|,', $response;
|
||||||
|
|
||||||
|
Log3( $name, 4,
|
||||||
|
qq{GardenaSmartBridge ($name) - got result from asynchronous parsing} );
|
||||||
|
|
||||||
|
my $decode_json;
|
||||||
|
|
||||||
|
Log3( $name, 4, qq{GardenaSmartBridge ($name) - asynchronous finished.} );
|
||||||
|
|
||||||
|
if ( scalar(@response) > 0 ) {
|
||||||
|
for my $json (@response) {
|
||||||
|
|
||||||
|
#################
|
||||||
|
$decode_json = eval { decode_json($json) };
|
||||||
|
if ($@) {
|
||||||
|
Log3 $name, 5,
|
||||||
|
"GardenaSmartBridge ($name) - JSON error while request: $@";
|
||||||
|
}
|
||||||
|
|
||||||
|
Dispatch( $hash, $json, undef )
|
||||||
|
if ( $decode_json->{category} ne 'gateway' );
|
||||||
|
WriteReadings( $hash, $decode_json )
|
||||||
|
if ( defined( $decode_json->{category} )
|
||||||
|
&& $decode_json->{category} eq 'gateway' );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
sub PollChild {
|
sub PollChild {
|
||||||
my $hash = shift;
|
my $hash = shift;
|
||||||
|
|
||||||
@ -899,57 +916,24 @@ sub PollChild {
|
|||||||
|
|
||||||
if ( defined( $hash->{".fhem"}{subprocess} ) ) {
|
if ( defined( $hash->{".fhem"}{subprocess} ) ) {
|
||||||
my $subprocess = $hash->{".fhem"}{subprocess};
|
my $subprocess = $hash->{".fhem"}{subprocess};
|
||||||
my @response = $subprocess->readFromChild();
|
my $response = $subprocess->readFromChild();
|
||||||
|
|
||||||
Log3 $name, 3,
|
|
||||||
"GardenaSmartBridge ($name) - Response ist: " . Dumper @response;
|
|
||||||
|
|
||||||
if ( scalar(@response) == 0 ) {
|
|
||||||
Log3( $name, 5,
|
|
||||||
qq{GardenaSmartBridge ($name) - still waiting ($subprocess->{lasterror}).}
|
|
||||||
);
|
|
||||||
|
|
||||||
InternalTimer( gettimeofday() + 1,
|
|
||||||
"FHEM::GardenaSmartBridge::PollChild", $hash );
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
Log3( $name, 4,
|
|
||||||
qq{GardenaSmartBridge ($name) - got result from asynchronous parsing}
|
|
||||||
);
|
|
||||||
|
|
||||||
my $decode_json;
|
|
||||||
|
|
||||||
|
if ( defined($response) ) {
|
||||||
|
ResponseProcessingFinalFromSubProcessing( $hash, $response );
|
||||||
$subprocess->wait();
|
$subprocess->wait();
|
||||||
Log3( $name, 4,
|
|
||||||
qq{GardenaSmartBridge ($name) - asynchronous finished.} );
|
|
||||||
|
|
||||||
CleanSubprocess($hash);
|
CleanSubprocess($hash);
|
||||||
|
|
||||||
if ( scalar(@response) > 0 ) {
|
|
||||||
for my $json (@response) {
|
|
||||||
|
|
||||||
#################
|
|
||||||
$decode_json = eval { decode_json($json) };
|
|
||||||
if ($@) {
|
|
||||||
Log3 $name, 5,
|
|
||||||
"GardenaSmartBridge ($name) - JSON error while request: $@";
|
|
||||||
}
|
|
||||||
|
|
||||||
Dispatch( $hash, $json, undef )
|
|
||||||
if ( $decode_json->{category} ne 'gateway' );
|
|
||||||
WriteReadings( $hash, $decode_json )
|
|
||||||
if ( defined( $decode_json->{category} )
|
|
||||||
&& $decode_json->{category} eq 'gateway' );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
Log3 $name, 3,
|
|
||||||
"GardenaSmartBridge ($name) - It looks like so is no Array reference at response";
|
|
||||||
Log3 $name, 3,
|
|
||||||
"GardenaSmartBridge ($name) - Response ist: " . Dumper @response;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Log3( $name, 5,
|
||||||
|
qq{GardenaSmartBridge ($name) - still waiting ($subprocess->{lasterror}).}
|
||||||
|
);
|
||||||
|
|
||||||
|
InternalTimer( gettimeofday() + 1,
|
||||||
|
"FHEM::GardenaSmartBridge::PollChild", $hash );
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# ResponseSubprocessin muss in eine async ausgelagert werden
|
# ResponseSubprocessin muss in eine async ausgelagert werden
|
||||||
@ -966,17 +950,12 @@ sub ResponseSubprocessing {
|
|||||||
while ($json) {
|
while ($json) {
|
||||||
if ( defined($tail) and $tail ) {
|
if ( defined($tail) and $tail ) {
|
||||||
push @response, $json;
|
push @response, $json;
|
||||||
Log3 'Gardena Subprocess', 2,
|
|
||||||
"GardenaSmartBridge (Gardena) - JSON ist: $json";
|
|
||||||
}
|
}
|
||||||
|
|
||||||
( $json, $tail ) = ParseJSON($tail);
|
( $json, $tail ) = ParseJSON($tail);
|
||||||
}
|
}
|
||||||
|
|
||||||
Log3 'Gardena Subprocess', 2,
|
$subprocess->writeToParent( join '|', @response );
|
||||||
"GardenaSmartBridge (Gardena) - Response ist: " . Dumper @response;
|
|
||||||
|
|
||||||
$subprocess->writeToParent(@response);
|
|
||||||
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
@ -1036,8 +1015,6 @@ sub WriteReadings {
|
|||||||
my $hash = shift;
|
my $hash = shift;
|
||||||
my $decode_json = shift;
|
my $decode_json = shift;
|
||||||
|
|
||||||
# print Dumper $decode_json;
|
|
||||||
|
|
||||||
my $name = $hash->{NAME};
|
my $name = $hash->{NAME};
|
||||||
|
|
||||||
if ( defined( $decode_json->{id} )
|
if ( defined( $decode_json->{id} )
|
||||||
|
@ -72,15 +72,11 @@ 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'
|
||||||
@ -89,10 +85,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 ...
|
||||||
@ -100,10 +93,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 ...
|
||||||
@ -111,10 +101,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 ...
|
||||||
@ -122,20 +109,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;
|
||||||
}
|
};
|
||||||
}
|
};
|
||||||
}
|
};
|
||||||
}
|
};
|
||||||
}
|
};
|
||||||
|
|
||||||
## Import der FHEM Funktionen
|
## Import der FHEM Funktionen
|
||||||
#-- Run before package compilation
|
#-- Run before package compilation
|
||||||
|
@ -1,2 +1,2 @@
|
|||||||
UPD 2022-02-01_13:05:43 50198 FHEM/73_GardenaSmartBridge.pm
|
UPD 2022-02-01_16:59:23 49503 FHEM/73_GardenaSmartBridge.pm
|
||||||
UPD 2022-01-31_19:35:42 56993 FHEM/74_GardenaSmartDevice.pm
|
UPD 2022-02-01_16:37:05 56817 FHEM/74_GardenaSmartDevice.pm
|
||||||
|
Loading…
x
Reference in New Issue
Block a user