move the removed_dirs to TLUtils, and use it in TLMedia

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

3 files changed, 87 insertions, 77 deletions

diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 26b4d2dcc6b..0c21efda53b 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -2671,77 +2671,6 @@ sub check_for_critical_updates
 }
 
 
-# return all the directories from which all content will be removed
-#
-# idea:
-# - create a hashes by_dir listing all files that should be removed
-#   by directory, i.e., key = dir, value is list of files
-# - for each of the dirs (keys of by_dir and ordered deepest first)
-#   check that all actually contained files are removed
-#   and all the contained dirs are in the removal list. If this is the
-#   case put that directory into the removal list
-# - return this removal list
-#
-sub removed_dirs
-{
-  my (@files) = @_;
-  my %removed_dirs;
-  my %by_dir;
-
-  # construct hash of all directories mentioned, values are lists of the
-  # files/dirs in that directory.
-  for my $f (@files) {
-    # what should we do with not existing entries????
-    next if (! -r "$f");
-    my $abs_f = abs_path ($f);
-    if (!$abs_f) {
-      warn ("oops, no abs_path($f) from " . `pwd`);
-      next;
-    }
-    (my $d = $abs_f) =~ s,/[^/]*$,,;
-    my @a = exists $by_dir{$d} ? @{$by_dir{$d}} : ();
-    push (@a, $abs_f);
-    $by_dir{$d} = \@a;
-  }
-
-  # for each of our directories, see if we are removing everything in
-  # the directory.  if so, return the directory; else return the
-  # individual files.
-  for my $d (reverse sort keys %by_dir) {
-    opendir (DIR, $d) || die "opendir($d) failed: $!";
-    my @dirents = readdir (DIR);
-    closedir (DIR) || warn "closedir($d) failed: $!";
-
-    # initialize test hash with all the files we saw in this dir.
-    # (These idioms are due to "Finding Elements in One Array and Not
-    # Another" in the Perl Cookbook.)
-    my %seen;
-    my @rmfiles = @{$by_dir{$d}};
-    @seen{@rmfiles} = ();
-
-    # see if everything is the same.
-    my $cleandir = 1;
-    for my $dirent (@dirents) {
-      next if $dirent =~ /^\.(\.|svn)?$/;  # ignore . .. .svn
-      my $item = "$d/$dirent";  # prepend directory for comparison
-      if (
-           ((-d $item) && (defined($removed_dirs{$item})))
-           ||
-           (exists $seen{$item})
-         ) {
-        # do nothing
-      } else {
-        $cleandir = 0;
-        last;
-      }
-    }
-    if ($cleandir) {
-      $removed_dirs{$d} = 1;
-    }
-  }
-  return keys %removed_dirs;
-}
-
 __END__
 
 =head1 NAME
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 70c5cd67679..b79663dfbf7 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -425,15 +425,14 @@ sub remove_package {
         $localtlpdb->option_post_code);
     }
     # 
+    my @removals = &TeXLive::TLUtils::removed_dirs (@goodfiles);
     # now do the removal
-    foreach my $entry (@goodfiles) {
+    for my $entry (@goodfiles) {
       unlink $entry;
     }
-    tlwarn("MISSING REMOVAL OF EMPTY DIRECTORIES: sub removed_dirs needed!\n");
-    #my @removals = &removed_dirs (@goodfiles);
-    #foreach my $entry (@removals) {
-    #  rmdir $entry;
-    #}
+    for my $d (@removals) {
+      rmdir $d;
+    }
     $localtlpdb->remove_package($pkg);
     merge_into(\%ret, $tlp->make_return_hash_from_executes("disable"));
     $ret{'mktexlsr'} = 1;
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 9646e561c7d..caf3b02fad2 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -44,6 +44,8 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
   TeXLive::TLUtils::rmtree($root, $verbose, $safe);
   TeXLive::TLUtils::copy($file, $target_dir);
   TeXLive::TLUtils::touch(@files);
+  TeXLive::TLUtils::collapse_dirs(@files);
+  TeXLive::TLUtils::removed_dirs(@files);
   TeXLive::TLUtils::download_file($path, $destination [, $progs ]);
   TeXLive::TLUtils::setup_programs($bindir, $platform);
 
@@ -94,6 +96,7 @@ BEGIN {
     &copy
     &touch
     &collapse_dirs
+    &removed_dirs
     &install_package
     &install_packages
     &make_var_skeleton
@@ -919,6 +922,83 @@ sub collapse_dirs
   return @ret;
 }
 
+=item C<removed_dirs(@files)>
+
+returns all the directories from which all content will be removed
+
+=cut
+
+# return all the directories from which all content will be removed
+#
+# idea:
+# - create a hashes by_dir listing all files that should be removed
+#   by directory, i.e., key = dir, value is list of files
+# - for each of the dirs (keys of by_dir and ordered deepest first)
+#   check that all actually contained files are removed
+#   and all the contained dirs are in the removal list. If this is the
+#   case put that directory into the removal list
+# - return this removal list
+#
+sub removed_dirs
+{
+  my (@files) = @_;
+  my %removed_dirs;
+  my %by_dir;
+
+  # construct hash of all directories mentioned, values are lists of the
+  # files/dirs in that directory.
+  for my $f (@files) {
+    # what should we do with not existing entries????
+    next if (! -r "$f");
+    my $abs_f = abs_path ($f);
+    if (!$abs_f) {
+      warn ("oops, no abs_path($f) from " . `pwd`);
+      next;
+    }
+    (my $d = $abs_f) =~ s,/[^/]*$,,;
+    my @a = exists $by_dir{$d} ? @{$by_dir{$d}} : ();
+    push (@a, $abs_f);
+    $by_dir{$d} = \@a;
+  }
+
+  # for each of our directories, see if we are removing everything in
+  # the directory.  if so, return the directory; else return the
+  # individual files.
+  for my $d (reverse sort keys %by_dir) {
+    opendir (DIR, $d) || die "opendir($d) failed: $!";
+    my @dirents = readdir (DIR);
+    closedir (DIR) || warn "closedir($d) failed: $!";
+
+    # initialize test hash with all the files we saw in this dir.
+    # (These idioms are due to "Finding Elements in One Array and Not
+    # Another" in the Perl Cookbook.)
+    my %seen;
+    my @rmfiles = @{$by_dir{$d}};
+    @seen{@rmfiles} = ();
+
+    # see if everything is the same.
+    my $cleandir = 1;
+    for my $dirent (@dirents) {
+      next if $dirent =~ /^\.(\.|svn)?$/;  # ignore . .. .svn
+      my $item = "$d/$dirent";  # prepend directory for comparison
+      if (
+           ((-d $item) && (defined($removed_dirs{$item})))
+           ||
+           (exists $seen{$item})
+         ) {
+        # do nothing
+      } else {
+        $cleandir = 0;
+        last;
+      }
+    }
+    if ($cleandir) {
+      $removed_dirs{$d} = 1;
+    }
+  }
+  return keys %removed_dirs;
+}
+
 
 =item C<install_packages($from_tlpdb, $media, $to_tlpdb, $what, $opt_src, $opt_doc)>
 
@@ -1574,6 +1654,8 @@ sub untar {
   return $ret;
 }
 
+
+
 
 =item C<setup_programs($bindir, $platform)>