Meta.pm: maximize JSON performance and compatibility

git-svn-id: https://svn.fhem.de/fhem/trunk@19216 2b470e98-0d58-463d-a4d8-8e2adae1ed80

fhem/FHEM/42_npmjs.pm

@@ -32,9 +32,61 @@ use POSIX;
 use FHEM::Meta;
 
 use GPUtils qw(GP_Import);
-use JSON;
 use Data::Dumper;
 
+# 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;
+
+    # try to use JSON wrapper
+    #   for chance of better performance
+    eval {
+        require JSON;
+        import JSON qw( decode_json encode_json );
+        1;
+    };
+
+    if ($@) {
+        $@ = undef;
+
+        # In rare cases, Cpanel::JSON::XS may
+        #   be installed but JSON|JSON::MaybeXS not ...
+        eval {
+            require Cpanel::JSON::XS;
+            import Cpanel::JSON::XS qw(decode_json encode_json);
+            1;
+        };
+
+        if ($@) {
+            $@ = undef;
+
+            # In rare cases, JSON::XS may
+            #   be installed but JSON not ...
+            eval {
+                require JSON::XS;
+                import JSON::XS qw(decode_json encode_json);
+                1;
+            };
+
+            if ($@) {
+                $@ = undef;
+
+                # Fallback to built-in JSON which SHOULD
+                #   be available since 5.014 ...
+                require JSON::PP;
+                import JSON::PP qw(decode_json encode_json);
+                1;
+            }
+        }
+    }
+}
+
 # Run before module compilation
 BEGIN {
     # Import from main::
@@ -527,14 +579,14 @@ sub Get($$@) {
 
     my ( $cmd, @args ) = @aa;
 
-    if ( $cmd eq 'showOutdatedList' ) {
+    if ( lc($cmd) eq 'showoutdatedlist' ) {
         return "usage: $cmd" if ( @args != 0 );
 
         my $ret = CreateOutdatedList( $hash, $cmd );
         return $ret;
 
     }
-    elsif ( $cmd eq 'showInstalledList' ) {
+    elsif ( lc($cmd) eq 'showinstalledlist' ) {
         return "usage: $cmd" if ( @args != 0 );
 
         my $ret = CreateInstalledList( $hash, $cmd );
@@ -570,7 +622,7 @@ sub Get($$@) {
     #     return $ret;
     #
     # }
-    elsif ( $cmd eq 'showErrorList' ) {
+    elsif ( lc($cmd) eq 'showerrorlist' ) {
         return "usage: $cmd" if ( @args != 0 );
 
         my $ret = CreateErrorList($hash);
@@ -1406,7 +1458,8 @@ sub CreateInstalledList($$) {
     if ( ref($packages) eq "HASH" ) {
 
         my $linecount = 1;
-        foreach my $package ( sort keys( %{$packages} ) ) {
+        foreach my $package ( sort { "\L$a" cmp "\L$b" } keys( %{$packages} ) )
+        {
             next if ( $package eq "undefined" );
 
             my $l = $linecount % 2 == 0 ? $rowOpenEven : $rowOpenOdd;
@@ -1494,7 +1547,8 @@ sub CreateOutdatedList($$) {
     if ( ref($packages) eq "HASH" ) {
 
         my $linecount = 1;
-        foreach my $package ( sort keys( %{$packages} ) ) {
+        foreach my $package ( sort { "\L$a" cmp "\L$b" } keys( %{$packages} ) )
+        {
             next if ( $package eq "undefined" );
             my $fhemPkg = defined( $fhem_npm_modules{$package} ) ? 1 : 0;
 
@@ -1765,7 +1819,7 @@ sub ToDay() {
       "abstract": "Modul zur Bedienung der Node.js Installation und Updates"
     }
   },
-  "version": "v1.0.6",
+  "version": "v1.1.0",
   "release_status": "stable",
   "author": [
     "Julian Pawlowski <julian.pawlowski@gmail.com>"
@@ -1787,12 +1841,17 @@ sub ToDay() {
         "FHEM": 5.00918799,
         "perl": 5.014,
         "GPUtils": 0,
-        "JSON": 0,
+        "JSON::PP": 0,
-        "Data::Dumper": 0
+        "Data::Dumper": 0,
+        "SubProcess": 0
       },
       "recommends": {
+        "JSON": 0,
+        "JSON::MaybeXS": 0
       },
       "suggests": {
+        "Cpanel::JSON::XS": 0,
+        "JSON::XS": 0
       }
     }
   },

fhem/FHEM/98_Installer.pm

@@ -37,11 +37,63 @@ use POSIX;
 use FHEM::Meta;
 
 use GPUtils qw(GP_Import);
-use JSON::PP;
 use Data::Dumper;
 use Config;
 use ExtUtils::Installed;
 
+# 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;
+
+    # try to use JSON wrapper
+    #   for chance of better performance
+    eval {
+        require JSON;
+        import JSON qw( decode_json encode_json );
+        1;
+    };
+
+    if ($@) {
+        $@ = undef;
+
+        # In rare cases, Cpanel::JSON::XS may
+        #   be installed but JSON|JSON::MaybeXS not ...
+        eval {
+            require Cpanel::JSON::XS;
+            import Cpanel::JSON::XS qw(decode_json encode_json);
+            1;
+        };
+
+        if ($@) {
+            $@ = undef;
+
+            # In rare cases, JSON::XS may
+            #   be installed but JSON not ...
+            eval {
+                require JSON::XS;
+                import JSON::XS qw(decode_json encode_json);
+                1;
+            };
+
+            if ($@) {
+                $@ = undef;
+
+                # Fallback to built-in JSON which SHOULD
+                #   be available since 5.014 ...
+                require JSON::PP;
+                import JSON::PP qw(decode_json encode_json);
+                1;
+            }
+        }
+    }
+}
+
 # Run before module compilation
 BEGIN {
     # Import from main::
@@ -1754,7 +1806,7 @@ sub CreateInstalledPerlList($$) {
           . $tHOpen
           . $trOpen;
 
-        push @ret, $thOpen . 'Package Name' . $thClose;
+        push @ret, $thOpen . 'Name' . $thClose;
         push @ret, $thOpen . 'Version' . $thClose;
         push @ret, $trClose . $tHClose;
 
@@ -1917,7 +1969,7 @@ sub CreateOutdatedPerlList($$) {
               . $tHOpen
               . $trOpen;
 
-            push @ret, $thOpen . 'Package Name' . $thClose;
+            push @ret, $thOpen . 'Name' . $thClose;
             push @ret, $thOpen . 'Current Version' . $thClose;
             push @ret, $thOpen . 'Latest Version' . $thClose;
             push @ret, $trClose . $tHClose;
@@ -2253,15 +2305,15 @@ sub CreatePrereqsList {
                   . $mAttr . ' '
                   . ucfirst($area)
                   . '</a></div>';
-                # push @ret,
+                push @ret,
-                #     ( $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd )
+                    ( $linecount % 2 == 0 ? $trOpenEven : $trOpenOdd )
-                #   . $tdOpen3
+                  . $tdOpen3
-                #   . $tdClose
+                  . $tdClose
-                #   . $tdOpen1
+                  . $tdOpen1
-                #   . $action
+                  . $action
-                #   . $tdClose
+                  . $tdClose
-                #   . $trClose
+                  . $trClose
-                #   if ($html);
+                  if ($html);
 
                 push @ret, $tBClose;
 
@@ -5424,16 +5476,19 @@ sub __list_module {
         "Config": 0,
         "ExtUtils::Installed": 0,
         "B": 0,
-        "JSON": 0,
+        "JSON::PP": 0,
         "perl": 5.014,
         "version": 0,
         "SubProcess": 0
       },
       "recommends": {
         "Perl::PrereqScanner::NotQuiteLite": 0,
-        "Time::Local": 0
+        "JSON": 0,
+        "JSON::MaybeXS": 0
       },
       "suggests": {
+        "Cpanel::JSON::XS": 0,
+        "JSON::XS": 0
       }
     }
   },

fhem/FHEM/Meta.pm

@@ -1241,11 +1241,62 @@ m/(^#\s+(?:\d{1,2}\.\d{1,2}\.(?:\d{2}|\d{4})\s+)?[^v\d]*(v?(?:\d{1,3}\.\d{1,3}(?
         $encoding = 'latin1' unless ($encoding);
 
         if ( keys %json > 0 ) {
+
+            # try to use JSON::MaybeXS wrapper
+            #   for chance of better performance + open code
+            # See: https://perlmaven.com/comparing-the-speed-of-json-decoders
             eval {
-                require JSON::PP;
+                require JSON::MaybeXS;
-                JSON::PP->import();
+                import JSON::MaybeXS qw( decode_json );
                 1;
             };
+            if ($@) {
+                $@ = undef;
+
+                # try to use JSON wrapper
+                #   for chance of better performance
+                eval {
+                    require JSON;
+                    import JSON qw( decode_json );
+                    1;
+                };
+
+                if ($@) {
+                    $@ = undef;
+
+                    # In rare cases, Cpanel::JSON::XS may
+                    #   be installed but JSON|JSON::MaybeXS not ...
+                    eval {
+                        require Cpanel::JSON::XS;
+                        import Cpanel::JSON::XS qw(decode_json encode_json);
+                        1;
+                    };
+
+                    if ($@) {
+                        $@ = undef;
+
+                        # In rare cases, JSON::XS may
+                        #   be installed but JSON not ...
+                        eval {
+                            require JSON::XS;
+                            import JSON::XS qw(decode_json encode_json);
+                            1;
+                        };
+
+                        if ($@) {
+                            $@ = undef;
+
+                            # Fallback to built-in JSON which SHOULD
+                            #   be available since 5.014 ...
+                            eval {
+                                require JSON::PP;
+                                import JSON::PP qw(decode_json encode_json);
+                                1;
+                            };
+                        }
+                    }
+                }
+            }
 
             if ( !$@ ) {
                 foreach ( keys %json ) {
@@ -3052,7 +3103,7 @@ sub __SetXVersion {
     "2019-04-18": {
       "version": "v0.5.1",
       "changes": [
-        "use built-in JSON:PP instead of JSON"
+        "improved JSON dependencies"
       ]
     },
     "2019-04-16": {
@@ -3099,14 +3150,18 @@ sub __SetXVersion {
         "Data::Dumper": 0,
         "Module::CoreList": 0,
         "Encode": 0,
-        "version": 0
+        "version": 0,
+        "JSON::PP": 0
       },
       "recommends": {
-        "JSON::PP": 0,
+        "JSON": 0,
+        "JSON::MaybeXS": 0,
         "Perl::PrereqScanner::NotQuiteLite": 0,
         "Time::Local": 0
       },
       "suggests": {
+        "JSON::XS": 0,
+        "Cpanel::JSON::XS": 0
       }
     }
   },