From 8c684b90efa9d3d0e61b8d8136482cd7b5afc3a4 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Fri, 23 Jan 2009 19:45:11 +0000 Subject: * 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 --- Master/tlpkg/TeXLive/TLPOBJ.pm | 26 ++++++++++-- Master/tlpkg/TeXLive/TLUtils.pm | 91 ++++++++++++++++++++++++++++++++++++++++- Master/tlpkg/bin/tlprm | 77 ++++------------------------------ 3 files changed, 121 insertions(+), 73 deletions(-) diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index 52734cc54fa..9947c43ca7e 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -515,6 +515,8 @@ sub make_container { for my $f (@files) { if (-f $f || -l $f) { push(@files_to_backup, $f); + } elsif (! -e $f) { + tlwarn("$0: (make_container $containername) $f does not exist\n"); } else { tlwarn("$0: (make_container $containername) $f not file or symlink\n"); } @@ -532,9 +534,27 @@ sub make_container { } else { # For Unix, we pass all the files on the command line, because there # is no portable (across different platforms and different tars) way - # to pass them on stdin. This can be a lengthy command line, but - # modern systems have enough argv space -- our biggest package is - # tex4ht, which needs about 200k. + # to pass them on stdin. Unfortunately, this can be too lengthy of + # a command line -- our biggest package is tex4ht, which needs about + # 200k. CentOS 5.2, at least, starts complaining around 140k. + # + # Therefore, if the command is likely to be too long, we call + # our collapse_dirs routine; in practice, this eliminates + # essentially all the individual files, leaving just a few + # directories, which is no problem. (For example, tex4ht collapses + # down to five directories and one file.) + # + # Although in principle we could do this in all cases, collapse_dirs + # isn't the most thoroughly tested function in the world. It seems + # safer to only do it in the (few) potentially problematic cases. + # + if (length ("@files_to_backup") > 50000) { + @files_to_backup = TeXLive::TLUtils::collapse_dirs(@files_to_backup); + # A complication, as always. collapse_dirs returns absolute paths. + # We want to change them back to relative so that the backup tar + # has the same structure. + s,^$instroot/,, foreach @files_to_backup; + } push(@cmdline, @files_to_backup); } diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 719036dbcc1..1f051a89dbe 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -90,6 +90,7 @@ BEGIN { &rmtree © &touch + &collapse_dirs &install_package &install_packages &make_var_skeleton @@ -845,10 +846,9 @@ sub copy { } - =item C -Update modification and access time of C<@files>. Non existent files +Update modification and access time of C<@files>. Non-existent files are created. =cut @@ -868,6 +868,93 @@ sub touch { + + +=item C + +Return a (more or less) minimal list of directories and files, given an +original list of files C<@files>. That is, if every file within a given +directory is included in C<@files>, replace all of those files with the +absolute directory name in the return list. Any files which have +sibling files not included are retained and made absolute. + +We try to walk up the tree so that the highest-level directory +containing only directories or files that are in C<@files> is returned. +(This logic may not be perfect, though.) + +This is not just a string function; we check for other directory entries +existing on disk within the directories of C<@files>. Therefore, if the +entries are relative pathnames, the current directory must be set by the +caller so that file tests work. + +As mentioned above, the returned list is absolute paths to directories +and files. + +For example, suppose the input list is + + dir1/subdir1/file1 + dir1/subdir2/file2 + dir1/file3 + +If there are no other entries under C, the result will be +C. + +=cut + +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 = Cwd::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 given 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 $ok_to_collapse = 1; + for my $dirent (@dirents) { + next if $dirent =~ /^\.(\.|svn)?$/; # ignore . .. .svn + + my $item = "$d/$dirent"; # prepend directory for comparison + if (! exists $seen{$item}) { + $ok_to_collapse = 0; + last; # no need to keep looking after the first. + } + } + + push (@ret, $ok_to_collapse ? $d : @{$by_dir{$d}}); + } + + if (@ret != @files) { + @ret = &collapse_dirs (@ret); + } + return @ret; +} + + =item C Installs the list of packages found in C<@$what> (a ref to a list) into 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 -- cgit v1.2.3