diff options
| -rwxr-xr-x | Master/tlpkg/bin/tlpfiles | 89 |
1 files changed, 80 insertions, 9 deletions
diff --git a/Master/tlpkg/bin/tlpfiles b/Master/tlpkg/bin/tlpfiles index 4a35056cad1..5e2c56d85e6 100755 --- a/Master/tlpkg/bin/tlpfiles +++ b/Master/tlpkg/bin/tlpfiles @@ -21,11 +21,15 @@ use TeXLive::TLPDB; use Pod::Usage; use Getopt::Long; +our $FILE; +our %DB_BY_FILE; # used privately below. + +our @opt_pkgof = (); our $opt_debug = 0; my $man = 0; my $help = 0; -GetOptions("pkgof" => \@opt_pkgof, +GetOptions("pkgof=s" => \@opt_pkgof, "debug!", "help|?" => \$help, "man" => \$man) or pod2usage(2); pod2usage(1) if $help; @@ -35,17 +39,23 @@ exit (&main ()); sub main { - die "$0: expected exactly one package name; try --help if you need it.\n" - if @ARGV != 1; - my $pkg = $ARGV[0]; - my $Master = "$mydir/../.."; # xx TLPDB should default my $tlpdb_path = "$Master/texlive.tlpdb"; - my $tlpdb = TeXLive::TLPDB->new (location => "$tlpdb_path"); + + if (@opt_pkgof) { + return &do_pkgof ($tlpdb_path, @opt_pkgof); + + } elsif (@ARGV != 1) { + die "$0: expected exactly one package name; try --help if you need it.\n"; + } + + # report files in given package. + my $pkg = $ARGV[0]; + + my $tlpdb = TeXLive::TLPDB->new (location => $tlpdb_path); my $obj = $tlpdb->get_package ($pkg); - die "$0: no TeX Live package named $pkg.\n" - if ! $obj; + die "$0: no TeX Live package named $pkg in $tlpdb_path.\n" if ! $obj; my @files = $obj->all_files; print "$_\n" foreach @files; @@ -53,9 +63,66 @@ sub main return 0; } -exit 0; + +# Report which package(s) the given files belong to. +# +sub do_pkgof +{ + my ($tlpdb,@files) = @_; + + @files = split (/\s/, "@files"); + for my $f (@files) { + my $pkg = &find_pkg_of_file ($tlpdb, $f); + printf "%s\t%s\n", $pkg || "-", $f; + } + + return 0; +} + + +# return package to which FILE belongs, or undef. +# +# any directory part of FILE is stripped. If there are multiple +# packages holding files by the same name, all are returned, +# space-separated. +# +# Because this strange inverse operation is not needed for anything +# else, we don't attempt to implement it in the usual modules. Instead, +# we read the raw tlpdb file. +# +sub find_pkg_of_file +{ + my ($tlpdb,$file) = @_; + + if (! keys %DB_BY_FILE) { + local *FILE; + $FILE = $tlpdb; + open (FILE) || die "open($FILE) failed: $!"; + my $pkg; + while (<FILE>) { + chomp; + if (/^name /) { + (undef,$pkg) = split (/ /); + } elsif (/^ /) { + # we carefully designed the format so that the only lines with + # leading spaces are the files. here we just take the basename. + (my $dbfile = $_) =~ s,^.*/,,; + $DB_BY_FILE{$dbfile} .= "$pkg "; + } + } + close (FILE) || warn "close($FILE) failed: $!"; + } + + $file =~ s,^.*/,,; # take basename + # strict stupidity + my $ret = exists $DB_BY_FILE{$file} ? substr ($DB_BY_FILE{$file}, 0, -1) + : ""; + return $ret; # omit final space, +} + +__END__ =head1 NAME @@ -100,6 +167,10 @@ package in which each given I<FILE> is contained, or C<-> if no package can be found. The files may be given as a single whitespace-separated argument, or the C<-pkgof> option may be given more than once, or both. +Any directory part of the files is stripped. If there are multiple +packages holding files by the same name, all are returned, +space-separated, followed by a tab, followed by the basename searched for. + =head1 AUTHORS AND COPYRIGHT This script and its documentation were written for the TeX Live |