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