diff options
Diffstat (limited to 'Master/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 82 |
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 { © &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)> |