texlive[69955] Master/texmf-dist/scripts/texlive/tlmgr.pl: tlmgr bug:

[commits+preining at tug.org]

Revision: 69955
          https://tug.org/svn/texlive?view=revision&revision=69955
Author:   preining
Date:     2024-02-18 13:33:25 +0100 (Sun, 18 Feb 2024)
Log Message:
-----------
tlmgr bug: accept argument, better presentation

Modified Paths:
--------------
    trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl

Modified: trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl
===================================================================
--- trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl	2024-02-18 12:33:15 UTC (rev 69954)
+++ trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl	2024-02-18 12:33:25 UTC (rev 69955)
@@ -6964,12 +6964,15 @@
     chomp($ans);
     return $F_OK, $ans;
   }
+  my ($ans) = @ARGV;
   init_local_db();
-  my ($ok, $ans);
-  ($ok, $ans) = prompt_it("Which package or file do you want to report a bug against:", 1);
-  if ($ok == $F_ERROR) {
-    print "Bailing out!\n";
-    return $F_ERROR;
+  if (!$ans) {
+    my $ok;
+    ($ok, $ans) = prompt_it("Package or file to report a bug against:", 1);
+    if ($ok == $F_ERROR) {
+      print "Bailing out!\n";
+      return $F_ERROR;
+    }
   }
   # first search for packages that match $ans, and if not search for files
   my $tlp = $localtlpdb->get_package($ans);
@@ -6979,28 +6982,69 @@
   # we are still here, so search for a file that matches
   my $fndptr = _search_tlpdb($localtlpdb, $ans,
     1, # search files,
-    0, # don't search descriptions
+    1, # don't search descriptions
     1  # don't search within words
   );
-  my @found_pkgs = sort keys %$fndptr;
+  my @deschit;
+  for my $pkg (sort keys %$fndptr) {
+    if ($fndptr->{$pkg}{'desc'}) {
+      push @deschit, [$pkg, "$pkg (" . $fndptr->{$pkg}{'desc'} . ")\n"] ;
+      # delete files if we found it already via description (which includes package name)
+      # since we don't want to show the same package two times, and the files hit will
+      # be mostly based on the directory name
+      delete $fndptr->{$pkg}{'files'};
+    }
+  }
+  my @filehit;
+  for my $pkg (sort keys %$fndptr) {
+    if ($fndptr->{$pkg}{'files'}) {
+      push @filehit, [$pkg, "$pkg\n\t" . join("\n\t", sort keys %{$fndptr->{$pkg}{'files'}}) . "\n"];
+    }
+  }
+  my $nr_total_hit = $#deschit + 1 + $#filehit + 1;
   my $pkg;
-  if ($#found_pkgs > 0) {
-    print "Multiple matching packages found for term $ans:\n";
-    for my $i (0..$#found_pkgs) {
-      print $i, " $found_pkgs[$i]\n";
+  if ($nr_total_hit > 1) {
+    my $n = 1;
+    if ($#deschit >= 0) {
+      print "\nPackage matches:\n";
+      for my $i (0..$#deschit) {
+        print "$n. $deschit[$i][1]";
+        $n++;
+      }
     }
-    print "Select a package: ";
+    if ($#filehit >= 0) {
+      print "\nFile matches:\n";
+      for my $i (0..$#filehit) {
+        print "$n. $filehit[$i][1]";
+        $n++;
+      }
+    }
+    print "\nSelect a package: ";
     my $pkgidx = <STDIN>;
-    if (!defined($pkgidx) or int($pkgidx) < 0 or int($pkgidx) > $#found_pkgs) {
-      print "Bailing out!\n";
+    chomp($pkgidx);
+    if ($pkgidx !~ /^\d+$/) {
+      print "Not a number, exiting.\n";
       return $F_ERROR;
     }
-    chomp($pkgidx);
-    $pkg = $found_pkgs[int($pkgidx)];
-  } elsif ($#found_pkgs == 0) {
-    $pkg = $found_pkgs[0];
+    $pkgidx = int($pkgidx);
+    if (!defined($pkgidx) or $pkgidx < 1 or $pkgidx > $nr_total_hit) {
+      print "Number out of range, exiting.\n";
+      return $F_ERROR;
+    }
+    print "PKGINDEX = $pkgidx\n";
+    if ($pkgidx <= $#deschit) {
+      $pkg = $deschit[$pkgidx - 1][0];
+    } else {
+      $pkg = $filehit[$pkgidx - 1 - $#deschit - 1][0];
+    }
+  } elsif ($nr_total_hit == 1) {
+    if ($#deschit == 0) {
+      $pkg = $deschit[0][0];
+    } else {
+      $pkg = $filehit[0][0];
+    }
   } else {
-    print "Nothing found, bailing out\n";
+    print "Nothing found.\n";
     return $F_OK;
   }
   $tlp = $localtlpdb->get_package($pkg);