texlive[45530] Master: tlmgr info: allow for --data json

[commits+preining at tug.org]

Revision: 45530
          http://tug.org/svn/texlive?view=revision&revision=45530
Author:   preining
Date:     2017-10-13 03:41:42 +0200 (Fri, 13 Oct 2017)
Log Message:
-----------
tlmgr info: allow for --data json

Modified Paths:
--------------
    trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl
    trunk/Master/tlpkg/TeXLive/TLPOBJ.pm

Modified: trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl
===================================================================
--- trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl	2017-10-13 00:22:17 UTC (rev 45529)
+++ trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl	2017-10-13 01:41:42 UTC (rev 45530)
@@ -210,6 +210,7 @@
   "info" => { 
     "options"  => { 
       "data" => "=s",
+      "all" => 1,
       "list" => 1, 
       "only-installed" => 1,
     },
@@ -1403,7 +1404,28 @@
   my $ret = $F_OK | $F_NOPOSTACTION;
   my @datafields;
   my $fmt = "list";
-  if ($opts{'data'}) {
+  if ($opts{'data'} eq "json") {
+    eval { require 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:PP, that should not happen as we ship it!\n(Error message: $@)\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.
+";
+      }
+    }
+    $fmt = 'json';
+    # the 1 is the silent mode!
+    init_tlmedia_or_die(1);
+  } elsif ($opts{'data'}) {
     # output format is changed to csv with " as quotes
     # we need to determine the fields
     @datafields = split(',', $opts{'data'});
@@ -1431,14 +1453,21 @@
   }
   # we are still here, so $what is defined and neither collection nor scheme,
   # so assume the arguments are package names
-  $fmt = ($opts{'data'} ? "csv" : "detail");
+  if ($opts{'data'} ne "json") {
+    $fmt = ($opts{'data'} ? "csv" : "detail");
+  }
   my @adds;
   if ($opts{'data'}) {
     @adds = @datafields;
   }
+  print "[\n" if ($fmt eq "json");
+  my $first = 1;
   foreach my $ppp ($what, @todo) {
+    print "," if ($fmt eq "json" && !$first);
+    $first = 0;
     $ret |= show_one_package($ppp, $fmt, @adds);
   }
+  print "]\n" if ($fmt eq "json");
   return ($ret);
 }
 
@@ -3559,6 +3588,8 @@
     $ret = show_one_package_detail($pkg, @rest);
   } elsif ($fmt eq "csv") {
     $ret = show_one_package_csv($pkg, @rest);
+  } elsif ($fmt eq "json") {
+    $ret = show_one_package_json($pkg);
   } else {
     tlwarn("$prg: show_one_package: unknown format: $fmt\n");
     return($F_ERROR);
@@ -3566,6 +3597,24 @@
   return($ret);
 }
 
+sub show_one_package_json {
+  my ($p) = @_;
+  my @out;
+  my $loctlp = $localtlpdb->get_package($p);
+  my $remtlp = $remotetlpdb->get_package($p);
+  my $is_installed = (defined($loctlp) ? 1 : 0);
+  my $is_available = (defined($remtlp) ? 1 : 0);
+  if (!($is_installed || $is_available)) {
+    tlwarn("$prg: package $p not found neither locally nor remote!\n");
+    return($F_WARNING);
+  }
+  my $tlp = ($is_installed ? $loctlp : $remtlp);
+  my $str = $tlp->as_json();
+  print $str, "\n";
+  return($F_OK);
+}
+
+
 sub show_one_package_csv {
   my ($p, @datafields) = @_;
   my @out;
@@ -7632,7 +7681,11 @@
 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
+JSON encoded array where each array element is the JSON representation of
+the internal object.
 
+
 =back
 
 =head2 init-usertree

Modified: trunk/Master/tlpkg/TeXLive/TLPOBJ.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLPOBJ.pm	2017-10-13 00:22:17 UTC (rev 45529)
+++ trunk/Master/tlpkg/TeXLive/TLPOBJ.pm	2017-10-13 01:41:42 UTC (rev 45530)
@@ -420,6 +420,16 @@
   }
 }
 
+sub as_json {
+  my $self = shift;
+  require JSON;
+  #my $json = JSON::PP->new->utf8;
+  my %foo = %{$self};
+  my $utf8_encoded_json_text = JSON::encode_json(\%foo); #  $json->encode(\%foo);
+  return $utf8_encoded_json_text;
+}
+
+
 sub cancel_reloc_prefix {
   my $self = shift;
   my @docfiles = $self->docfiles;