From 0fb22d85243d60319fb496dd0b0a5e1c3bcbeaa7 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Sun, 24 May 2020 18:16:16 +0000 Subject: (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 --- Master/tlpkg/bin/tl-update-docindex | 78 ++++++++++++++++++++++++++++++++++--- 1 file changed, 72 insertions(+), 6 deletions(-) (limited to 'Master/tlpkg') 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
  • $name\n#; - push @lines, qq#(CTAN):\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#(CTAN):\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 @@ sub push_pkg_list { push @lines, "$list\n
  • \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; + } +} -- cgit v1.2.3