texlive[55256] Master/tlpkg/bin/tl-update-docindex: (find_doc_dir):

[commits+karl at tug.org]

Revision: 55256
          http://tug.org/svn/texlive?view=revision&revision=55256
Author:   karl
Date:     2020-05-24 20:16:16 +0200 (Sun, 24 May 2020)
Log Message:
-----------
(find_doc_dir): new fn to guess TL directory to
link to; the dir of the first docfile is not
always best.

Modified Paths:
--------------
    trunk/Master/tlpkg/bin/tl-update-docindex

Modified: trunk/Master/tlpkg/bin/tl-update-docindex
===================================================================
--- trunk/Master/tlpkg/bin/tl-update-docindex	2020-05-24 10:16:15 UTC (rev 55255)
+++ trunk/Master/tlpkg/bin/tl-update-docindex	2020-05-24 18:16:16 UTC (rev 55256)
@@ -14,8 +14,11 @@
 use TeXLive::TLPDB;
 use File::Basename;
 
+my $CATALOGUE_DIR = "/home/httpd/html/catalogue/entries";
+
 exit(main());
 
+

 sub main {
     my $tlpdb = TeXLive::TLPDB->new('root' => "$progdir/../..");
     die "$progname: unable to load TLPDB\n" unless defined $tlpdb;
@@ -54,6 +57,7 @@
     return 0;
 }
 
+

 # print the links for letters, then packages
 sub print_all_pkg {
     my ($tlpdb) = @_;
@@ -65,6 +69,7 @@
     # first build the output and the list of initials
     for my $tlpn (sort {lc $a cmp lc $b} $tlpdb->list_packages) {
         next if $tlpn =~ /^00texlive\./; # don't bother with infra packages.
+        next if $tlpn =~ /texlive-docindex/;
         my $tlpkg = $tlpdb->get_package($tlpn);
         push_pkg_list($tlpkg);
     }
@@ -77,6 +82,7 @@
     print $access;
 }
 
+

 # push the content for a package to the list of lines
 sub push_pkg_list {
     my ($tlpkg) = @_;
@@ -87,7 +93,7 @@
     @docfiles = grep { m/\.(html|pdf)/ } @docfiles;
     if (@docfiles == 0) {
       # but in one notable case, koma-script, it is in runfiles,
-      # per the author's request/requirement.
+      # per the author's specification.
       my @runfiles = $tlpkg->runfiles;
       @docfiles = grep { m/\.(html|pdf)/ } @runfiles;
     }
@@ -97,7 +103,7 @@
     $n++; # list counter
 
     # check initial
-    my $init = uc substr $name, 0, 1;
+    my $init = uc(substr($name, 0, 1));
     unless ($init eq $current_letter) {
         $current_letter = $init;
         # put header in the big list...
@@ -109,7 +115,7 @@
     }
 
     # if there is an index.html file, drop the rest
-    # currently (2009-10-07) catches: FAQ-en bosisio epspdf fontname jadetex
+    # catches, e.g.: FAQ-en bosisio epspdf fontname jadetex
     # metapost ppower4 sttools tds tex4ht
     my @index = grep /\/index\.html/, @docfiles;
     if (@index == 1) {
@@ -117,12 +123,24 @@
         @docfiles = @index;
     }
 
-    # print package name with shortdesc
-    my $dir = dirname($docfiles[0]);
+    # print package name with ctan link and shortdesc
     my $id = qq!id="$name"!; # should be unique
+    my $dir = &find_doc_dir($name, @docfiles);
     push @lines, qq#\n<li $id><b><a href="$dir">$name</a></b><small>\n#;
-    push @lines, qq#(<a href="https://ctan.org/pkg/$name">CTAN</a>):\n#;
+    #
+    # Don't link to CTAN if the package doesn't exist.
+    # We could find more by looking at the .tlpsrc, but let's skip
+    # until someone notices. Except 12many works, and it's the very
+    # first one, so add that in.
+    my $lc_name = lc($name);
+    my $name1 = substr($name, 0, 1); # for Catalogue check
+    push @lines, qq#(<a href="https://ctan.org/pkg/$name">CTAN</a>):\n#
+      if -r "$CATALOGUE_DIR/$name1/$lc_name.xml" || $name eq "12many";
+    #
     my $shortdesc = $tlpkg->shortdesc;
+    # a few shortdescs already end with a period:
+    $shortdesc =~ s/\.$// if defined $shortdesc;
+    #push @lines, "$shortdesc. \n" if defined $shortdesc;
     push @lines, "$shortdesc\n" if defined $shortdesc;
     #warn "$name\n" if not defined $shortdesc;
 
@@ -140,3 +158,51 @@
     push @lines, "$list\n</small></li>\n";
 }
 
+

+# Return best documentation directory for package NAME among @DOCFILES.
+# 
+sub find_doc_dir {
+  my ($name, at docfiles) = @_;
+
+  my $shortest_dir = "a" x 1000;
+  my $name_dir = "";
+  for my $f (@docfiles) {
+    my $dir = dirname($f);
+    
+    # if we find a file in a directory named for the package,
+    # that seems like the best possible choice.
+    if ($dir =~ m,/$name$,) {
+      return $dir;
+
+    # if we are in the $name/base/ directory, e.g., amstex/base.
+    } elsif ($dir =~ m,/$name/base$,) {
+      return $dir;
+
+    # else if we are one directory from the package name,
+    # e.g., authorarchive/examples, can probably use it.
+    } elsif ($dir =~ m,/$name/[^/]+$,) {
+      $name_dir = dirname($dir);
+      
+    # otherwise, shorter is probably better.
+    } elsif (length($dir) < length($shortest_dir)) {
+      $shortest_dir = $dir;
+      ; #warn "set shortest $shortest_dir from $f for $name\n";
+    } else {
+      ; #warn "have $shortest_dir, ignoring $dir from $f\n";
+    }
+  }
+
+  # a directory by name is probably better than just the shortest.
+  return "$name_dir/" if $name_dir;
+  
+  if ($shortest_dir !~ m,/,) {
+    # should never happen except for texlive.infra, which has the
+    # top-level index.html, so it works out ok.
+    warn "no shortest dir for $name, should never happen! docfiles=@docfiles"
+      unless $name eq "texlive.infra";
+    return "";
+  } else {
+    ; #warn "returning shortest $shortest_dir for $name\n";
+    return $shortest_dir;
+  }
+}