json rework:

tlmgr info: switch from --data json to --json
tlmgr restore: support json output for listing
all: use TeXLive::JSON

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

2 files changed, 76 insertions, 30 deletions

diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl
index a9c1a7b0782..2081493933a 100755
--- a/Master/texmf-dist/scripts/texlive/tlmgr.pl
+++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl
@@ -169,7 +169,7 @@ my %action_specification = (
     "function" => \&action_conf
   },
   "dump-tlpdb" => { 
-    "options"  => { local => 1, remote => 1, json => 1 },
+    "options"  => { local => 1, remote => 1 },
     "run-post" => 0,
     "function" => \&action_dumptlpdb
   },
@@ -356,9 +356,11 @@ sub main {
   my %globaloptions = (
     "gui" => 1,
     "gui-lang" => "=s",
+    "debug-json-timing" => 1,
     "debug-translation" => 1,
     "h|?" => 1,
     "help" => 1,
+    "json" => 1,
     "location|repository|repo" => "=s",
     "machine-readable" => 1,
     "no-execute-actions" => 1,
@@ -1412,23 +1414,21 @@ sub action_info {
   my $ret = $F_OK | $F_NOPOSTACTION;
   my @datafields;
   my $fmt = "list";
-  if ($opts{'data'} && ($opts{'data'} eq "json")) {
-    eval { require JSON; };
+  if ($opts{'data'} && $opts{'json'}) {
+    tlwarn("Preferring json output over data output!\n");
+    delete($opts{'data'});
+  }
+  if ($opts{'json'}) {
+    eval { require TeXLive::JSON; };
     if ($@) {
       # that didn't work out, give some usefull error message and stop
       if ($^O =~ /^MSWin/i) {
         # that should not happen, we are shipping Tk!!
         require Win32;
-        my $msg = "Cannot load JSON, that should not happen as we ship it!\n(Error message: $@)\n";
+        my $msg = "Cannot load JSON, that should not happen as we ship it!\n(Error message: $@)\nStopping here.\n";
         Win32::MsgBox($msg, 1|Win32::MB_ICONSTOP(), "Warning");
-      } else {
-        printf STDERR "
-$prg: Cannot load JSON. 
-This module is shipped with core Perl unless you have a very old Perl,
-in which case you cannot use the json option.
-Goodbye.
-";
       }
+      tldie("Cannot load JSON module, this should not happen, please report!\n");
     }
     $fmt = 'json';
     # the 1 is the silent mode!
@@ -1447,6 +1447,8 @@ Goodbye.
     $fmt = "csv";
     # the 1 is the silent mode!
     init_tlmedia_or_die(1);
+  } else {
+    $fmt = "detail";
   }
   my $tlm;
   if ($opts{"only-installed"}) {
@@ -1480,17 +1482,16 @@ Goodbye.
   } else {
     @whattolist = ($what, @todo);
   }
-  if ($opts{'data'}) {
-    if ($opts{'data'} ne "json") {
-      $fmt = "csv";
-    }
-  } else {
-    $fmt = "detail";
-  }
   my @adds;
   if ($opts{'data'}) {
     @adds = @datafields;
   }
+  # TIMING OF JSON IMPLEMENTATIONS
+  my ($startsec, $startmsec);
+  if ($opts{'debug-json-timing'}) {
+    require Time::HiRes;
+    ($startsec, $startmsec) = Time::HiRes::gettimeofday();
+  }
   print "[" if ($fmt eq "json");
   my $first = 1;
   foreach my $ppp (@whattolist) {
@@ -1500,6 +1501,16 @@ Goodbye.
     $ret |= show_one_package($ppp, $fmt, @adds);
   }
   print "]\n" if ($fmt eq "json");
+  if ($opts{'debug-json-timing'}) {
+    my ($endsec, $endmsec) = Time::HiRes::gettimeofday();
+    if ($endmsec < $startmsec) {
+      $endsec -= 1;
+      $endmsec += 1000000;
+    }
+    print STDERR "start $startsec $startmsec\n";
+    print STDERR "end   $endsec $endmsec\n";
+    print STDERR "duration ", $endsec - $startsec, ":", $endmsec - $startmsec, "\n";
+  }
   return ($ret);
 }
 
@@ -1807,8 +1818,12 @@ sub action_restore {
   # intermediate sub
   sub report_backup_revdate {
     my $p = shift;
+    my $mode = shift;
     my %revs = @_;
     my @rs = sort {$b <=> $a} (keys %revs);
+    my %jsonkeys;
+    $jsonkeys{'name'} = $p;
+    my @outarr;
     for my $rs (@rs) {
       my $dstr;
       if ($revs{$rs} == -1) {
@@ -1820,17 +1835,31 @@ sub action_restore {
         $dstr = sprintf "%04d-%02d-%02d %02d:%02d", 
           $year+1900, $mon+1, $mday, $hour, $min;
       }
-      print "$rs ($dstr) ";
+      if ($mode eq "json") {
+        $jsonkeys{'rev'} = "$rs";
+        $jsonkeys{'date'} = $dstr;
+        push @outarr, TeXLive::TLUtils::simple_hash_to_json(\%jsonkeys);
+      } else {
+        push @outarr, "$rs ($dstr)";
+      }
     }
+    join(($mode eq "json" ? "," : " "), @outarr);
   }
   # end sub
   if (!defined($pkg)) {
     if (keys %backups) {
-      print "Available backups:\n";
-      foreach my $p (sort keys %backups) {
-        print "$p: ";
-        report_backup_revdate($p, %{$backups{$p}});
-        print "\n";
+      if ($opts{'json'}) {
+        my $str = "[";
+        $str .= join(",", map { report_backup_revdate($_, "json", %{$backups{$_}}) } keys %backups);
+        $str .= "]\n";
+        print $str;
+      } else {
+        print "Available backups:\n";
+        foreach my $p (sort keys %backups) {
+          print "$p: ";
+          print(report_backup_revdate($p, "text", %{$backups{$p}}));
+          print "\n";
+        }
       }
     } else {
       print "No backups available in $opts{'backupdir'}\n";
@@ -1838,9 +1867,16 @@ sub action_restore {
     return ($F_OK | $F_NOPOSTACTION);
   }
   if (!defined($rev)) {
-    print "Available backups for $pkg: ";
-    report_backup_revdate($pkg, %{$backups{$pkg}});
-    print "\n";
+    if ($opts{'json'}) {
+      my $str = "[";
+      $str .= report_backup_revdate($pkg, "json", %{$backups{$pkg}});
+      $str .= "]\n";
+      print $str;
+    } else {
+      print "Available backups for $pkg: ";
+      print(report_backup_revdate($pkg, "text", %{$backups{$pkg}}));
+      print "\n";
+    }
     return ($F_OK | $F_NOPOSTACTION);
   }
   # we did arrive here, so we try to restore ...
@@ -7670,10 +7706,13 @@ packages' information is listed in CSV format one package per line, and the
 column information is given by the C<itemN>. The C<depends> column contains
 the name of all dependencies separated by C<:>.
 
-In case the only value passed to C<--data> is C<json>, the output is a
+=item B<--json>
+
+In case C<--json> is specified, the output is a
 JSON encoded array where each array element is the JSON representation of
 a single C<TLPOBJ> but with additional information. For details see
 C<tlpkg/doc/JSON-formats.txt>, format definition: C<TLPOBJINFO>.
+If both C<--json> and C<--data> are given, C<--json> takes precedence.
 
 
 =back
@@ -8115,7 +8154,7 @@ otherwise, all operations will fail!
 
 =back
 
-=head2 restore [--backupdir I<dir>] [--all | I<pkg> [I<rev>]]
+=head2 restore [--json] [--backupdir I<dir>] [--all | I<pkg> [I<rev>]]
 
 Restore a package from a previously-made backup.
 
@@ -8156,6 +8195,13 @@ written to the terminal.
 
 Don't ask questions.
 
+=item B<--json>
+
+When listing backups, the option C<--json> turn on JSON output.
+The format is an array of JSON objects (C<name>, C<rev>, C<date>).
+For details see C<tlpkg/doc/JSON-formats.txt>, format definition: C<TLBACKUPS>.
+If both C<--json> and C<--data> are given, C<--json> takes precedence.
+
 =back
 
 =head2 search [I<option>...] I<what>
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 8dadf1723fd..75bcc33491c 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -423,7 +423,7 @@ sub writeout_simple {
 sub as_json {
   my $self = shift;
   my %addargs = @_;
-  require JSON;
+  require TeXLive::JSON;
   #my $json = JSON::PP->new->utf8;
   my %foo = %{$self};
   # set the additional args