From e08ed8299a4973061c37dd704f8bdbd7db8c8fce Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Sat, 6 Jun 2009 17:09:55 +0000 Subject: 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 --- Master/texmf/scripts/texlive/tlmgr.pl | 71 ------------------------------ Master/tlpkg/TeXLive/TLMedia.pm | 11 +++-- Master/tlpkg/TeXLive/TLUtils.pm | 82 +++++++++++++++++++++++++++++++++++ 3 files changed, 87 insertions(+), 77 deletions(-) (limited to 'Master') 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 -- 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 + +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 @@ -1574,6 +1654,8 @@ sub untar { return $ret; } + + =item C -- cgit v1.2.3