texlive[51721] Master/tlpkg/bin/tlpkginfo: (catalogue_find_file): new

[commits+karl at tug.org]

Revision: 51721
          http://tug.org/svn/texlive?view=revision&revision=51721
Author:   karl
Date:     2019-07-25 00:01:07 +0200 (Thu, 25 Jul 2019)
Log Message:
-----------
(catalogue_find_file): new fn.
(prepare): use it to extract .tds.zip path from
catalogue file, instead of guessing; remove some
special cases that are no longer needed as a result.

Modified Paths:
--------------
    trunk/Master/tlpkg/bin/tlpkginfo

Modified: trunk/Master/tlpkg/bin/tlpkginfo
===================================================================
--- trunk/Master/tlpkg/bin/tlpkginfo	2019-07-24 21:30:54 UTC (rev 51720)
+++ trunk/Master/tlpkg/bin/tlpkginfo	2019-07-24 22:01:07 UTC (rev 51721)
@@ -78,10 +78,6 @@
        hacm inriafonts imtekda mathdesign tufte-latex xassoccnt),
     );
   
-  # Heiko's tds files (don't propagate through CTAN fast enough).
-  # Heiko is no longer actively maintaining,disable.
-  $oberdiek_tds = "no-hyperref|no-oberdiek";
-
   # special packages from latex-tds project; used by prepare()
   $latex_tds_pkgs  = "latex-tds";
   $latex_tds_pkgs .= "|psnfss"; # amsmath|cyrillic|graphics|latex|tools on own
@@ -285,6 +281,18 @@
   return $cat;
 }
 
+# If we find a Catalogue .xml file for PKGNAME, return the path
+# to it. Else return undef.
+# 
+sub catalogue_find_file {
+  my ($pkgname) = @_;
+  
+  # Happily, the Catalogue uses all-lowercase file/directory names.
+  my $firstchar = substr (lc ($pkgname), 0, 1);
+  my $catfile =  "$CATALOGUE/$firstchar/$pkgname.xml";
+  return -r $catfile ? $catfile : undef;
+}
+
 

 # Look up ctan path for given PKGNAME in catalogue entry.
 # xml is too hard to parse, so just look for the <ctan path...> entry.
@@ -295,12 +303,10 @@
 # 
 sub catalogue_find_ctan_path {
   my ($pkgname,$do_copy) = @_;
+
+  my $catfile = &catalogue_find_file ($pkgname);
+  return undef if ! $catfile;
   
-  # catalogue uses all-lowercase file/directory names.
-  my $firstchar = substr (lc ($pkgname), 0, 1);
-  my $catfile =  "$CATALOGUE/$firstchar/$pkgname.xml";
-  return undef unless -r $catfile;
-
   # get the raw tag from the catalogue file.
   open (CATFILE, "<$catfile") || die "open($catfile) failed, fixme: $!";
   while ($ctan_path = <CATFILE>) {
@@ -320,7 +326,7 @@
   return undef unless $ctan_path;             # if it's not present at all
 
   # extract just the dir or file name, without options, etc.
-  $ctan_path =~ m,path=(["'])/(.*?)\1,;
+  $ctan_path =~ m,path *= *(["'])/(.*?)\1,;
   $ctan_loc = $2;
   if (! $ctan_loc) {
     # should never happen, but who knows
@@ -374,17 +380,32 @@
 #warn "prepare: ctan_loc for $pkg = $ctan_loc\n";
   return $ctan_loc if $pkg =~ /^($erroneous_tds)$/;
 
-  # tds path is usually in ctan/install...
-  my $tds_path = $ctan_loc ? "$ctan_loc.tds.zip" : "";
-  $tds_path =~ s,^$CTAN,$CTAN/install,;
-#warn "prepare: tds_path for $pkg = $tds_path\n";
+  # Ordinarily the Catalogue specifies the .tds.zip file location.
+  my $tds_path = "";
+  my $catname = tlpsrc_find_catalogue ($pkg);
+  my $catfile = &catalogue_find_file ($catname || $pkg);
+  if ($catfile) {
+    open (CATFILE, "<$catfile") || die "open($catfile) failed, fixme: $!";
+    # looking for a line like <install path='...'/>
+    # We don't really want to parse xml; turns out these are always on
+    # their own lines, so simple enough to extract.
+    my $install_path = "";
+    while ($install_path = <CATFILE>) {
+      last if $install_path =~ /<install .*path/;
+    }
+    close CATFILE;
+    if ($install_path) {
+      $install_path =~ m,path *= *(["'])(.*?)\1,;
+      if ($2) { # else already initialized to empty
+        # install paths are relevant to the install subtree of CTAN.
+        $tds_path = "$CTAN/install$2";
+      }
+    } 
+  }
+  
+#warn "prepare: initial tds_path for $pkg = $tds_path\n";
   # ...except for heiko, when running on tug.org...
-  if ($pkg =~ /^($oberdiek_tds)$/) {
-    $tds_path = "/home/ftp/tex/$pkg/$pkg.tds.zip";
-    # will be ignored below if it doesn't exist.
-
-  # ...and except for context, and plenty more...
-  } elsif ($pkg eq "context") {
+  if ($pkg eq "context") {
     $tds_path = "/home/ftp/mirror/www.pragma-ade.nl/context/current/cont-tmf.zip";
 
   } elsif ($pkg eq "cmexb") {
@@ -402,21 +423,15 @@
   } elsif ($pkg eq "latex") {
     $tds_path = "$CTAN/install/macros/latex/latex-base.tds.zip";
 
-  } elsif ($pkg =~ /^(amsmath|cyrillic|graphics|tools)$/) {
-    $tds_path = "$CTAN/install/macros/latex/required/latex-$pkg.tds.zip";
-
-  } elsif ($pkg eq "babel") {
-    $tds_path = "$CTAN/install/macros/latex/required/babel-base.tds.zip";
-
-  } elsif ($pkg eq "pgf") {
-    $tds_path = "$CTAN/install/graphics/pgf/base/pgf.tds.zip";
-
   # ...and except for files in latex-tds...
   } elsif ($pkg =~ /^($latex_tds_pkgs)$/) {
     $tds_path = "$latex_tds_dir/$pkg.tds.zip";
   }
 
-  return $ctan_loc unless (-s $tds_path);
+  my $tds_path_ok = -s $tds_path ? 1 : 0;
+#warn "prepare:   final tds path for $pkg = $tds_path (exists: $tds_path_ok)\n";
+
+  return $ctan_loc if ! $tds_path_ok;
   
   # now we have a tds, so unzip it in a tmpdir and be sure it's readable.
   my $tmpdir = &copy_to_tmpdir ($pkg);