tlmgr dump-tlpdb -json possible

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

3 files changed, 57 insertions, 7 deletions

diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl
index eb0ed19d3e9..febca48d334 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 },
+    "options"  => { local => 1, remote => 1, json => 1 },
     "run-post" => 0,
     "function" => \&action_dumptlpdb
   },
@@ -1378,14 +1378,22 @@ sub action_dumptlpdb {
   $::machinereadable = 1;
   
   if ($opts{"local"} && !$opts{"remote"}) {
-    # for consistency we write out the location of the installation,
-    # too, in the same format as when dumping the remote tlpdb
-    print "location-url\t", $localtlpdb->root, "\n";
-    $localtlpdb->writeout;
+    if ($opts{"json"}) {
+      print $localtlpdb->as_json;
+    } else {
+      # for consistency we write out the location of the installation,
+      # too, in the same format as when dumping the remote tlpdb
+      print "location-url\t", $localtlpdb->root, "\n";
+      $localtlpdb->writeout;
+    }
 
   } elsif ($opts{"remote"} && !$opts{"local"}) {
-    init_tlmedia_or_die();
-    $remotetlpdb->writeout;
+    init_tlmedia_or_die(1);
+    if ($opts{"json"}) {
+      print $remotetlpdb->as_json;
+    } else {
+      $remotetlpdb->writeout;
+    }
 
   } else {
     tlwarn("$prg dump-tlpdb: need exactly one of --local and --remote.\n");
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 1dcdb3b91cb..b34650c84e3 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -28,6 +28,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
   $tlpdb->from_file($filename);
   $tlpdb->writeout;
   $tlpdb->writeout(FILEHANDLE);
+  $tlpdb->as_json;
   $tlpdb->save;
   $tlpdb->media;
   $tlpdb->available_architectures();
@@ -466,6 +467,43 @@ sub writeout {
 
 =pod
 
+=item C<< $tlpdb->as_json >>
+
+The C<as_json> function returns a JSON UTF8 encoded representation of the
+database, that is a JSON array of packages. If the database is virtual,
+a JSON array where each element is a hash with two keys, C<tag> giving
+the tag of the sub-database, and C<tlpdb> giving the JSON of the database.
+
+=cut
+
+sub as_json {
+  my $self = shift;
+  my $ret;
+  if ($self->is_virtual) {
+    $ret = "[\n";
+    my $firsttlpdb = 1;
+    for my $k (keys %{$self->{'tlpdbs'}}) {
+      $ret .= ",\n" if (!$firsttlpdb);
+      $ret .= "{ \"tag\" : \"$k\", \"tlpdb\" : ";
+      $firsttlpdb = 0;
+      $ret .= $self->{'tlpdbs'}{$k}->as_json;
+      $ret .= " }";
+    }
+    $ret .= "\n]";
+  } else {
+    $ret = "[\n";
+    my $first = 1;
+    foreach (keys %{$self->{'tlps'}}) {
+      $ret .= ",\n" if (!$first);
+      $first = 0;
+      $ret .= $self->{'tlps'}{$_}->as_json;
+    }
+    $ret .= "\n]";
+  }
+}
+
+=pod
+
 =item C<< $tlpdb->save >>
 
 The C<save> functions saves the C<TLPDB> to the file which has been set
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 77f2290e442..3e603bc99a3 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -1585,6 +1585,10 @@ or the filehandle if given:
 
 debugging function for comparison with C<tpm>/C<tlps>, will go away.
 
+=item C<as_json>
+
+returns the representation of the C<TLPOBJ> in JSON format.
+
 =item C<common_texmf_tree>
 
 if all files of the package are from the same texmf tree, this tree