summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xMaster/texmf-dist/scripts/texlive/tlmgr.pl136
1 files changed, 113 insertions, 23 deletions
diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl
index ec6715a38e1..df245a8314f 100755
--- a/Master/texmf-dist/scripts/texlive/tlmgr.pl
+++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl
@@ -147,6 +147,9 @@ my %action_specification = (
"run-post" => 1,
"function" => \&action_backup
},
+ "bug" => {
+ "function" => \&action_bug
+ },
"candidates" => {
"run-post" => 0,
"function" => \&action_candidates
@@ -1851,10 +1854,9 @@ sub action_search {
return ($F_OK | $F_NOPOSTACTION);
}
-sub search_tlpdb {
+sub _search_tlpdb {
my ($tlpdb, $what, $dofile, $dodesc, $inword) = @_;
- my $retfile = '';
- my $retdesc = '';
+ my %pkgs;
foreach my $pkg ($tlpdb->list_packages) {
my $tlp = $tlpdb->get_package($pkg);
@@ -1862,9 +1864,8 @@ sub search_tlpdb {
if ($dofile) {
my @ret = search_pkg_files($tlp, $what);
if (@ret) {
- $retfile .= "$pkg:\n";
foreach (@ret) {
- $retfile .= "\t$_\n";
+ $pkgs{$pkg}{'files'}{$_} = 1;
}
}
}
@@ -1872,28 +1873,43 @@ sub search_tlpdb {
# no options or --all -> search package names/descriptions
if ($dodesc) {
next if ($pkg =~ m/\./);
- my $matched = search_pkg_desc($tlp, $what, $inword);
- $retdesc .= "$matched\n" if ($matched);
+ my $t = "$pkg\n";
+ $t = $t . $tlp->shortdesc . "\n" if (defined($tlp->shortdesc));
+ $t = $t . $tlp->longdesc . "\n" if (defined($tlp->longdesc));
+ $t = $t . $tlp->cataloguedata->{'topics'} . "\n" if (defined($tlp->cataloguedata->{'topics'}));
+ my $pat = $what;
+ $pat = '\W' . $what . '\W' if ($inword);
+ my $matched = "";
+ if ($t =~ m/$pat/i) {
+ my $shortdesc = $tlp->shortdesc || "";
+ $pkgs{$pkg}{'desc'} = $shortdesc;
+ }
}
}
- return($retfile, $retdesc);
+ return \%pkgs;
}
-sub search_pkg_desc {
- my ($tlp, $what, $inword) = @_;
- my $pkg = $tlp->name;
- my $t = "$pkg\n";
- $t = $t . $tlp->shortdesc . "\n" if (defined($tlp->shortdesc));
- $t = $t . $tlp->longdesc . "\n" if (defined($tlp->longdesc));
- $t = $t . $tlp->cataloguedata->{'topics'} . "\n" if (defined($tlp->cataloguedata->{'topics'}));
- my $pat = $what;
- $pat = '\W' . $what . '\W' if ($inword);
- my $matched = "";
- if ($t =~ m/$pat/i) {
- my $shortdesc = $tlp->shortdesc || "";
- $matched .= "$pkg - $shortdesc";
- }
- return $matched;
+
+sub search_tlpdb {
+ my ($tlpdb, $what, $dofile, $dodesc, $inword) = @_;
+ my $fndptr = _search_tlpdb($tlpdb, $what, $dofile, $dodesc, $inword);
+ # first report on $pkg - $shortdesc found
+ my $retfile = '';
+ my $retdesc = '';
+ for my $pkg (sort keys %$fndptr) {
+ if ($fndptr->{$pkg}{'desc'}) {
+ $retdesc .= "$pkg - " . $fndptr->{$pkg}{'desc'} . "\n";
+ }
+ }
+ for my $pkg (sort keys %$fndptr) {
+ if ($fndptr->{$pkg}{'files'}) {
+ $retfile .= "$pkg:\n";
+ for my $f (keys %{$fndptr->{$pkg}{'files'}}) {
+ $retfile .= "\t$f\n";
+ }
+ }
+ }
+ return($retfile, $retdesc);
}
sub search_pkg_files {
@@ -6930,6 +6946,75 @@ sub action_shell {
}
+# BUG
+# interactive bug support
+#
+sub action_bug {
+ sub prompt_it {
+ my ($q, $required, $default) = @_;
+ print "$q ";
+ my $ans = <STDIN>;
+ if (!defined($ans)) {
+ if ($required) {
+ return $F_ERROR, "";
+ } else {
+ return $F_OK, $default;
+ }
+ }
+ chomp($ans);
+ return $F_OK, $ans;
+ }
+ 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;
+ }
+ # first search for packages that match $ans, and if not search for files
+ my $tlp = $localtlpdb->get_package($ans);
+ if ($tlp) {
+ return issue_bug_info_for_package($tlp);
+ }
+ # 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 within words
+ );
+ my @found_pkgs = sort keys %$fndptr;
+ 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";
+ }
+ print "Select a package: ";
+ my $pkgidx = <STDIN>;
+ if (!defined($pkgidx) or int($pkgidx) < 0 or int($pkgidx) > $#found_pkgs) {
+ print "Bailing out!\n";
+ return $F_ERROR;
+ }
+ chomp($pkgidx);
+ $pkg = $found_pkgs[int($pkgidx)];
+ } elsif ($#found_pkgs == 0) {
+ $pkg = $found_pkgs[0];
+ } else {
+ print "Nothing found, bailing out\n";
+ return $F_OK;
+ }
+ $tlp = $localtlpdb->get_package($pkg);
+ return issue_bug_info_for_package($tlp);
+}
+
+sub issue_bug_info_for_package {
+ my $tlp = shift;
+ print $tlp->name, " ", $tlp->revision, "\n";
+ print "TODO\n";
+ return $F_OK;
+}
+
+
# Subroutines galore.
#
@@ -8278,6 +8363,11 @@ performed are written to the terminal.
=back
+=head2 bug
+
+Interactively guides through finding information where to report
+bugs.
+
=head2 candidates I<pkg>
Shows the available candidate repositories for package I<pkg>.