diff options
author | Karl Berry <karl@freefriends.org> | 2009-01-23 19:45:11 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2009-01-23 19:45:11 +0000 |
commit | 8c684b90efa9d3d0e61b8d8136482cd7b5afc3a4 (patch) | |
tree | 3155eb5a64c9a07fd167dd8719526fc8648a3258 /Master/tlpkg/bin/tlprm | |
parent | 73b090736899e09dcfe6482da6e1e2f3a03ebc8b (diff) |
* tlprm (collapse_dirs): move to ...
* TLUtils.pm: here.
* TLPOBJ.pm (make_container): call collapse_dirs to avoid too-lengthy
command lines for, e.g., tex4ht.
git-svn-id: svn://tug.org/texlive/trunk@11955 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/bin/tlprm')
-rwxr-xr-x | Master/tlpkg/bin/tlprm | 77 |
1 files changed, 9 insertions, 68 deletions
diff --git a/Master/tlpkg/bin/tlprm b/Master/tlpkg/bin/tlprm index dde4436337c..cfa18ba3ca4 100755 --- a/Master/tlpkg/bin/tlprm +++ b/Master/tlpkg/bin/tlprm @@ -1,6 +1,6 @@ #!/usr/bin/env perl # $Id$ -# Copyright 2007, 2008, 2009 TeX Users Group. +# Copyright 2007, 2008, 2009 TeX Users Group # This file is licensed under the GNU General Public License version 2 # or any later version. # @@ -24,7 +24,6 @@ use TeXLive::TLPSRC; use TeXLive::TLUtils; use Pod::Usage; use Getopt::Long; -use Cwd qw(abs_path); my $opt_help = 0; @@ -61,7 +60,7 @@ sub main # Commonly, we want to remove entire directories, not just all the # files in the directory. - my @removals = &collapse_dirs (@files); + my @removals = TeXLive::TLUtils::collapse_dirs (@files); my $removals = join ("", map { "$_\n" } @removals); my $TMPDIR = $ENV{"TMPDIR"} || "/tmp"; @@ -96,82 +95,24 @@ sub main print "svn commit -m'rm $f, REASON' `cat $commit_file`\n"; if (1) { # maybe only if debugging? - print "\nremovals ($rm_file):\n"; + print "\n\f ", @removals + 0, " removals ($rm_file):\n"; print `cat $rm_file`; - print "\ncommits ($commit_file):\n"; + # + chomp (my $ncommits = `wc -l <$commit_file`); + print "\n\f ", $ncommits, " commits ($commit_file):\n"; print `cat $commit_file`; - print "\nlist of files being removed:\n"; + # + print "\n\f ", @files + 0, " files being removed:\n"; print "$_\n" foreach @files; } } # Instead of rewriting the database here, I think we're better off - # just doing it nightly or whatever. For --svn purposes anyway. + # just doing it nightly or whatever. return $failure_count; } - -# Return FILES, filtered with containing directories. That is, look at -# the containing directories of each FILE. If every file within a given -# dir is included in FILES, replace those files with the directory name -# in the return list. Any files with sibling files not included are -# retained. -# -# We do not try to check anything recursively. It doesn't buy us -# anything, since we will eventually be running svn commands to remove -# these dirs/files, and it's harmless to list subdirs. -# -sub collapse_dirs -{ - my (@files) = @_; - my @ret = (); - my %by_dir; - - # construct hash of all directories mentioned, values are lists of the - # files in that directory. - for my $f (@files) { - my $abs_f = abs_path ($f); - die ("oops, no abs_path($f) from " . `pwd`) unless $abs_f; - (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 (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 @dironly = (); - for my $dirent (@dirents) { - next if $dirent =~ /^\.(\.|svn)?$/; # ignore . .. .svn - - my $item = "$d/$dirent"; # prepend directory for comparison - if (! exists $seen{$item}) { - push (@dironly, $item); - last; # no need to keep looking after the first. - } - } - - push (@ret, @dironly ? @{$by_dir{$d}} : $d); - } - - return @ret; -} - __END__ =head1 NAME |