From 340f5c8eff5fb4baaac3b9d9c48aa974f7a489a3 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Sat, 11 Nov 2017 07:21:13 +0000 Subject: json: dynamically select tl internal or external json mode git-svn-id: svn://tug.org/texlive/trunk@45745 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLPDB.pm | 15 ++- Master/tlpkg/TeXLive/TLPOBJ.pm | 12 +-- Master/tlpkg/TeXLive/TLUtils.pm | 196 +++++++++++++++++++++++++++++----------- 3 files changed, 153 insertions(+), 70 deletions(-) (limited to 'Master/tlpkg') diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index 9176a04e715..32015fa692d 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -479,7 +479,6 @@ the tag of the sub-database, and C giving the JSON of the database. sub as_json { my $self = shift; - require JSON; my $ret = "{"; if ($self->is_virtual) { my $firsttlpdb = 1; @@ -508,7 +507,7 @@ sub _as_json { if ($TeXLive::TLConfig::TLPDBOptions{$k}[0] =~ m/^n/) { $opts->{$k} += 0 if (exists($opts->{$k})); } elsif ($TeXLive::TLConfig::TLPDBOptions{$k}[0] eq "b") { - $opts->{$k} = ($opts->{$k} ? $JSON::true : $JSON::false) if (exists($opts->{$k})); + $opts->{$k} = ($opts->{$k} ? TeXLive::TLUtils::True() : TeXLive::TLUtils::False()) if (exists($opts->{$k})); } elsif ($k eq "location") { if (exists($opts->{$k})) { my %foo = TeXLive::TLUtils::repository_to_array($opts->{$k}); @@ -520,27 +519,27 @@ sub _as_json { } # the last else is plain strings, nothing to do } - $ret .= JSON::encode_json($opts); + $ret .= TeXLive::TLUtils::encode_json($opts); $ret .= ',"settings":'; my $sets = $self->settings; for my $k (keys %TeXLive::TLConfig::TLPDBSettings) { if ($TeXLive::TLConfig::TLPDBSettings{$k} eq "b") { - $sets->{$k} = ($sets->{$k} ? $JSON::true : $JSON::false) if (exists($sets->{$k})); + $sets->{$k} = ($sets->{$k} ? TeXLive::TLUtils::True() : TeXLive::TLUtils::False()) if (exists($sets->{$k})); } elsif ($TeXLive::TLConfig::TLPDBSettings{$k} eq "available_architectures") { delete($sets->{$k}); @{$sets->{$k}} = $self->available_architectures; } # else are strings } - $ret .= JSON::encode_json($sets); + $ret .= TeXLive::TLUtils::encode_json($sets); $ret .= ',"configs":'; my %cfgs; - $cfgs{'container_split_src_files'} = ($self->config_src_container ? $JSON::true : $JSON::false); - $cfgs{'container_split_doc_files'} = ($self->config_doc_container ? $JSON::true : $JSON::false); + $cfgs{'container_split_src_files'} = ($self->config_src_container ? TeXLive::TLUtils::True() : TeXLive::TLUtils::False()); + $cfgs{'container_split_doc_files'} = ($self->config_doc_container ? TeXLive::TLUtils::True() : TeXLive::TLUtils::False()); $cfgs{'container_format'} = $self->config_container_format; $cfgs{'release'} = $self->config_release; $cfgs{'minrelease'} = $self->config_minrelease; - $ret .= JSON::encode_json(\%cfgs); + $ret .= TeXLive::TLUtils::encode_json(\%cfgs); $ret .= ',"tlpkgs": ['; my $first = 1; foreach (keys %{$self->{'tlps'}}) { diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index 8dadf1723fd..82eaf531ce4 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -423,8 +423,6 @@ sub writeout_simple { sub as_json { my $self = shift; my %addargs = @_; - require JSON; - #my $json = JSON::PP->new->utf8; my %foo = %{$self}; # set the additional args for my $k (keys %addargs) { @@ -445,9 +443,9 @@ sub as_json { # encode boolean as boolean flags if (exists($foo{'relocated'})) { if ($foo{'relocated'}) { - $foo{'relocated'} = $JSON::true; + $foo{'relocated'} = TeXLive::TLUtils::True(); } else { - $foo{'relocated'} = $JSON::false; + $foo{'relocated'} = TeXLive::TLUtils::False(); } } # adjust the docfiles entry to the specification in JSON-formats @@ -469,11 +467,7 @@ 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); + my $utf8_encoded_json_text = TeXLive::TLUtils::encode_json(\%foo); return $utf8_encoded_json_text; } 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 -- 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 +=item C -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 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 to either C or C (all other values are +ignored). If C is requested and the C 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 +=item C + +these two function must be used to get proper JSON C and C +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); } -- cgit v1.2.3