first cut at --pkgof, trying to implement amsref

git-svn-id: svn://tug.org/texlive/trunk@5187 c570f23f-e606-0410-a88d-b1316a301751

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