summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLUtils.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm196
1 files changed, 143 insertions, 53 deletions
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 3be5b0eb697..54ed8dbac53 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -103,10 +103,9 @@ C<TeXLive::TLUtils> -- utilities used in TeX Live infrastructure
=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);
+ TeXLive::TLUtils::encode_json($ref);
+ TeXLive::TLUtils::True();
+ TeXLive::TLUtils::False();
=head1 DESCRIPTION
@@ -195,7 +194,9 @@ BEGIN {
&get_full_line
&sort_archs
&repository_to_array
- &simple_hash_to_json
+ &encode_json
+ &True
+ &False
);
@EXPORT = qw(setup_programs download_file process_logging_options
tldie tlwarn info log debug ddebug dddebug debug_hash
@@ -4164,20 +4165,145 @@ sub repository_to_array {
return %r;
}
-=item C<simple_hash_tpo_json($hashref)>
+=item C<encode_json($ref)>
-Returns the JSON representation of C<$hashref>. Only simple key/value
-hashes are supported, and all entries are treated as strings.
+Returns the JSON representation of the object C<$ref> is pointing at.
+This tries to load the C<JSON> Perl module, and uses it if available,
+otherwise falls back to module internal conversion.
+
+The used backend can be selected by setting the environment variable
+C<TL_JSONMODE> to either C<json> or C<texlive> (all other values are
+ignored). If C<json> is requested and the C<JSON> module cannot be loaded
+the program terminates.
=cut
-sub simple_hash_to_json {
- my $hr = shift;
- return
- "{" . join (",", map { "\"$_\":\"" . $hr->{$_} . "\"" } keys(%$hr)) . "}"
+my $TLTrueValue = 1;
+my $TLFalseValue = 0;
+my $TLTrue = \$TLTrueValue;
+my $TLFalse = \$TLFalseValue;
+bless $TLTrue, 'TLBOOLEAN';
+bless $TLFalse, 'TLBOOLEAN';
+
+my $jsonmode = "";
+
+=item C<True()>
+=item C<False()>
+
+these two function must be used to get proper JSON C<true> and C<false>
+in the output independent of the backend used.
+
+=cut
+
+sub True {
+ ensure_json_available();
+ if ($jsonmode eq "json") {
+ return($JSON::true);
+ } else {
+ return($TLTrue);
+ }
+}
+sub False {
+ ensure_json_available();
+ if ($jsonmode eq "json") {
+ return($JSON::false);
+ } else {
+ return($TLFalse);
+ }
+}
+
+sub ensure_json_available {
+ return if ($jsonmode);
+ # check the environment for mode to use:
+ # $ENV{'TL_JSONMODE'} = texlive | json
+ my $envdefined = 0;
+ if ($ENV{'TL_JSONMODE'}) {
+ $envdefined = 1;
+ if ($ENV{'TL_JSONMODE'} eq "texlive") {
+ $jsonmode = "texlive";
+ print STDERR "texlive json module used!\n";
+ return;
+ } elsif ($ENV{'TL_JSONMODE'} eq "json") {
+ # nothing to do
+ } else {
+ tlwarn("Unsupported mode \'$ENV{TL_JSONMODE}\' set in TL_JSONMODE, ignoring it!");
+ $envdefined = 0;
+ }
+ }
+ return if ($jsonmode); # was set to texlive
+ eval { require JSON; };
+ if ($@) {
+ # that didn't work out, use home-grown json
+ if ($envdefined) {
+ # environment asks for JSON but cannot be loaded, die!
+ tldie("env variable TL_JSONMODE request JSON module but cannot be load!\n");
+ }
+ $jsonmode = "texlive";
+ print STDERR "texlive json module used!\n";
+ } else {
+ $jsonmode = "json";
+ my $json = JSON->new;
+ print STDERR "JSON " . $json->backend . " used!\n";
+ }
+}
+
+sub encode_json {
+ my $val = shift;
+ ensure_json_available();
+ if ($jsonmode eq "json") {
+ my $utf8_encoded_json_text = JSON::encode_json($val);
+ return $utf8_encoded_json_text;
+ } else {
+ my $type = ref($val);
+ if ($type eq "") {
+ tldie("encode_json: accept only refs: $val");
+ } elsif ($type eq 'SCALAR') {
+ return(scalar_to_json($$val));
+ } elsif ($type eq 'ARRAY') {
+ return(array_to_json($val));
+ } elsif ($type eq 'HASH') {
+ return(hash_to_json($val));
+ } elsif ($type eq 'REF') {
+ return(encode_json($$val));
+ } elsif (Scalar::Util::blessed($val)) {
+ if ($type eq "TLBOOLEAN") {
+ return($$val ? "true" : "false");
+ } else {
+ tldie("encode_json: unsupported blessed object");
+ }
+ } else {
+ tldie("encode_json: unsupported format $type");
+ }
+ }
}
sub scalar_to_json {
+ sub looks_like_numeric {
+ # code from JSON/backportPP.pm
+ my $value = shift;
+ no warnings 'numeric';
+ # detect numbers
+ # string & "" -> ""
+ # number & "" -> 0 (with warning)
+ # nan and inf can detect as numbers, so check with * 0
+ return unless length((my $dummy = "") & $value);
+ return unless 0 + $value eq $value;
+ return 1 if $value * 0 == 0;
+ return -1; # inf/nan
+ }
+ my $val = shift;
+ if (defined($val)) {
+ if (looks_like_numeric($val)) {
+ return("$val");
+ } else {
+ return(string_to_json($val));
+ }
+ } else {
+ return("null");
+ }
+}
+
+sub string_to_json {
my $val = shift;
my %esc = (
"\n" => '\n',
@@ -4190,59 +4316,23 @@ sub scalar_to_json {
"\'" => '\\\'',
);
$val =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
- return($val);
+ return("\"$val\"");
}
sub hash_to_json {
my $hr = shift;
- my $ret = "{";
- my @keystr;
+ my @retvals;
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));
- }
+ push @retvals, "\"$k\":" . encode_json(\$val);
}
- $ret .= join(",",@keystr) . "}";
+ my $ret = "{" . join(",", @retvals) . "}";
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) . "]";
+ my $ret = "[" . join(",", map { encode_json(\$_) } @$hr) . "]";
return($ret);
}