add home-made json conversion

git-svn-id: svn://tug.org/texlive/trunk@45723 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 99 insertions, 3 deletions

diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 0ca7ebb6d19..8dadf1723fd 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -468,6 +468,11 @@ sub as_json {
   }
   $foo{'docfiles'} = [ @newdocf ];
   delete($foo{'docfiledata'});
+  #
+  # my home-made solution is a bit faster then JSON::PP
+  # but we still prefer that one for security ;-)
+  # If JSON::XS is installed, that is the fastest.
+  #my $utf8_encoded_json_text = TeXLive::TLUtils::hash_to_json(\%foo);
   my $utf8_encoded_json_text = JSON::encode_json(\%foo);
   return $utf8_encoded_json_text;
 }
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 3e63b4a2c08..3be5b0eb697 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -101,6 +101,13 @@ C<TeXLive::TLUtils> -- utilities used in TeX Live infrastructure
   TeXLive::TLUtils::prepend_own_path();
   TeXLive::TLUtils::repository_to_array($str);
 
+=head2 JSON
+
+  TeXLive::TLUtils::simple_hash_to_json($hashref);
+  TeXLive::TLUtils::scalar_to_json($hashref);
+  TeXLive::TLUtils::hash_to_json($hashref);
+  TeXLive::TLUtils::array_to_json($hashref);
+
 =head1 DESCRIPTION
 
 =cut
@@ -188,6 +195,7 @@ BEGIN {
     &get_full_line
     &sort_archs
     &repository_to_array
+    &simple_hash_to_json
   );
   @EXPORT = qw(setup_programs download_file process_logging_options
                tldie tlwarn info log debug ddebug dddebug debug_hash
@@ -4131,9 +4139,6 @@ sub prepend_own_path {
 }
 
 
-=back
-=cut
-
 sub repository_to_array {
   my $r = shift;
   my %r;
@@ -4159,6 +4164,92 @@ sub repository_to_array {
   return %r;
 }
 
+=item C<simple_hash_tpo_json($hashref)>
+
+Returns the JSON representation of C<$hashref>. Only simple key/value
+hashes are supported, and all entries are treated as strings.
+
+=cut
+
+sub simple_hash_to_json {
+  my $hr = shift;
+  return 
+    "{" . join (",", map { "\"$_\":\"" . $hr->{$_} . "\"" } keys(%$hr)) . "}"
+}
+
+sub scalar_to_json {
+  my $val = shift;
+  my %esc = (
+    "\n" => '\n',
+    "\r" => '\r',
+    "\t" => '\t',
+    "\f" => '\f',
+    "\b" => '\b',
+    "\"" => '\"',
+    "\\" => '\\\\',
+    "\'" => '\\\'',
+  );
+  $val =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
+  return($val);
+}
+
+sub hash_to_json {
+  my $hr = shift;
+  my $ret = "{";
+  my @keystr;
+  for my $k (keys(%$hr)) {
+    my $val = $hr->{$k};
+    if (!$val) {
+      push @keystr, "\"$k\":null";
+    } elsif (ref($val) eq "") {
+      push @keystr, "\"$k\":\"" . scalar_to_json($val) . "\"";
+    } elsif (ref($val) eq 'SCALAR') {
+      push @keystr, "\"$k\":\"" . scalar_to_json($$val) . "\"";
+    } elsif (ref($val) eq 'ARRAY') {
+      push @keystr, "\"$k\":" . array_to_json($val);
+    } elsif (ref($val) eq 'HASH') {
+      push @keystr, "\"$k\":" . hash_to_json($val);
+    } elsif (Scalar::Util::blessed($val)) {
+      if (ref($val) eq "JSON::PP::Boolean") {
+        push @keystr, "\"$k\":" . ($val == $JSON::true ? "true" : "false");
+      } else {
+        die "Unsupported blessed object!";
+      }
+    } else {
+      die("Unsupported reference in hash_to_json: " . ref($val));
+    }
+  }
+  $ret .= join(",",@keystr) . "}";
+  return($ret);
+}
+
+sub array_to_json {
+  my $hr = shift;
+  my $ret = "[";
+  my @keystr;
+  for my $val (@$hr) {
+    if (!$val) {
+      push @keystr, "null";
+    } elsif (ref($val) eq "") {
+      push @keystr, "\"" . scalar_to_json($val) . "\"";
+    } elsif (ref($val) eq 'SCALAR') {
+      push @keystr, "\"" . scalar_to_json($$val) . "\"";
+    } elsif (ref($val) eq 'ARRAY') {
+      push @keystr, array_to_json($val);
+    } elsif (ref($val) eq 'HASH') {
+      push @keystr, hash_to_json($val);
+    } else {
+      die("Unsupported reference in array_to_json");
+    }
+  }
+  $ret .= join(",",@keystr) . "]";
+  return($ret);
+}
+
+
+
+=back
+=cut
 
 1;
 __END__