summaryrefslogtreecommitdiff
path: root/Master/tlpkg/bin/tl-update-docindex
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2020-05-24 18:16:16 +0000
committerKarl Berry <karl@freefriends.org>2020-05-24 18:16:16 +0000
commit0fb22d85243d60319fb496dd0b0a5e1c3bcbeaa7 (patch)
treead7ff36b4394d8a5d7262387861df9f4ec8fa829 /Master/tlpkg/bin/tl-update-docindex
parent2a76ae362ff2412990b46035c336a49766dd4942 (diff)
(find_doc_dir): new fn to guess TL directory to
link to; the dir of the first docfile is not always best. git-svn-id: svn://tug.org/texlive/trunk@55256 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/bin/tl-update-docindex')
-rwxr-xr-xMaster/tlpkg/bin/tl-update-docindex78
1 files changed, 72 insertions, 6 deletions
diff --git a/Master/tlpkg/bin/tl-update-docindex b/Master/tlpkg/bin/tl-update-docindex
index d2568aaefff..8068665a24c 100755
--- a/Master/tlpkg/bin/tl-update-docindex
+++ b/Master/tlpkg/bin/tl-update-docindex
@@ -14,8 +14,11 @@ use Fatal qw(:void open close opendir closedir chdir mkdir);
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 @@ END_TRAILER
return 0;
}
+
# print the links for letters, then packages
sub print_all_pkg {
my ($tlpdb) = @_;
@@ -65,6 +69,7 @@ sub print_all_pkg {
# 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 @@ sub print_all_pkg {
print $access;
}
+
# push the content for a package to the list of lines
sub push_pkg_list {
my ($tlpkg) = @_;
@@ -87,7 +93,7 @@ sub push_pkg_list {
@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 @@ sub push_pkg_list {
$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 @@ sub push_pkg_list {
}
# 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 @@ sub push_pkg_list {
@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.&nbsp;\n" if defined $shortdesc;
push @lines, "$shortdesc\n" if defined $shortdesc;
#warn "$name\n" if not defined $shortdesc;
@@ -140,3 +158,51 @@ sub push_pkg_list {
push @lines, "$list\n</small></li>\n";
}
+
+# Return best documentation directory for package NAME among @DOCFILES.
+#
+sub find_doc_dir {
+ my ($name,@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;
+ }
+}