(compare_disk_vs_tlpobj): new fn to report on any

stray files that are in the package but did not
get matched by the tlpsrc patterns.


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

1 files changed, 40 insertions, 12 deletions

diff --git a/Master/tlpkg/libexec/place b/Master/tlpkg/libexec/place
index 509aa36b852..cc754a93c46 100755
--- a/Master/tlpkg/libexec/place
+++ b/Master/tlpkg/libexec/place
@@ -63,13 +63,14 @@ if ($Root eq 'texmf-doc') {
 
 die "top-level README in $Root, that can't be right" if -e "$Root/README";
 
-# initialize TLPDB
-my $tlpdb = new TeXLive::TLPDB ('root' => $M);
+# initialize TLPDB.
+my $tlpdb = new TeXLive::TLPDB ("root" => $M);
 # create TLTREE from stuff in cooked/$pkg
-my $tltree = TeXLive::TLTREE->new ('svnroot' => "$cooked/$package");
+my $tltree = TeXLive::TLTREE->new ("svnroot" => "$cooked/$package");
 $tltree->init_from_files;
 
-# get package from TLPDB;
+# get package from TLPDB.
+my %Old;
 my $tlpold = $tlpdb->get_package ($package);
 if (defined($tlpold)) {
   foreach ($tlpold->all_files) {
@@ -79,7 +80,7 @@ if (defined($tlpold)) {
   $newpackage = 1;
 }
 
-# create new tlpsrc and tlpobj
+# create new tlpsrc.
 my $tlpsrc = TeXLive::TLPSRC;
 my $tlpsrcfile = "$M/tlpkg/tlpsrc/$package.tlpsrc";
 if (! -r $tlpsrcfile) {
@@ -99,14 +100,17 @@ if (! -r $tlpsrcfile) {
 # make the new tlpobj.
 my $tlpnew = $tlpsrc->make_tlpobj($tltree, $M);
 
-# we took over the comparison of files from the ctan2tl script since
-# we are here in perl world, which makes it easier ...
+
+# show comparison of old and new.
 print "\n\f ";
+
+&compare_disk_vs_tlpobj ("$cooked/$package", $tlpnew);
+
 if (!defined($tlpold)) {
   print "place: $package not present in $M/$InfraLocation/$DatabaseName\n\n";
 } else {
   print "new vs. present $package (present is indented)\n";
-  my @oldfiles = $tlpold->all_files;
+  my @oldfiles = keys %Old;
   `rm -f $tmpfile.old`;
   foreach (sort @oldfiles) {
     `echo $_ >>$tmpfile.old`;
@@ -176,7 +180,7 @@ my $job = "tar cf - . | (cd $M && tar xf - )";
 &xsystem ($job);
 
 # sort so dirs will be added before subdirs.
-foreach $file (sort keys %New) {
+for my $file (sort keys %New) {
   if (! $Old{$file}) { 
     &add_file ("$M/$file");
   }
@@ -185,7 +189,6 @@ foreach $file (sort keys %New) {
 &xchdir ($cooked);
 &xsystem ("mv $package $package.done");
 
-
 if ($newpackage) {
   &add_file ("$M/tlpkg/tlpsrc/$package.tlpsrc");
 }
@@ -212,7 +215,7 @@ for my $dir (sort keys %dirs) {
 #
 close (DIRLIST) || warn "close($DIRLIST) failed: $!";
 
-# Always run svn update, even without --place.  This will let a user
+# Always run svn update, even without --place.  This will let a worker
 # detect that a particular package update has already been done by
 # someone else.
 print ("\nsvn update of those directories:\n");
@@ -222,7 +225,6 @@ exit (0);
 
 
 
-#--------------------------------------
 sub dirs
 {
     local @filenames;
@@ -285,7 +287,33 @@ sub add_file
   $dirs{$newdir}++;
 }
 
+
 
+# compare against independent list of files in the new hierarchy, in
+# case some of them did not get matched by the patterns.
+sub compare_disk_vs_tlpobj 
+{
+  my ($diskdir,$tlp) = @_;
+  chomp (my @files_on_disk = `cd $diskdir && find \! -type d`);
+  s,^\./,, foreach @files_on_disk;      # remove leading ./
+  @files_on_disk{@files_on_disk} = ();  # make list into hash
+  
+  for my $tlpfile ($tlp->all_files) {
+    if (exists $files_on_disk{$tlpfile}) {
+      delete $files_on_disk{$tlpfile};
+    } else {
+      print "$tlpfile in tlp but not on disk?!\n";
+    }
+  }
+  
+  print "\n*** not matched in new tlp: ",
+        join ("\n  ", keys %files_on_disk),
+        "\n"
+    if keys %files_on_disk;
+}
+
+
+
 sub xchdir
 {
   my ($dir) = @_;