diff options
| -rwxr-xr-x | Master/texmf-dist/scripts/texlive/tlmgr.pl | 136 |
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>. |