summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLUtils.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm82
1 files changed, 82 insertions, 0 deletions
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)>