summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2009-01-23 19:45:11 +0000
committerKarl Berry <karl@freefriends.org>2009-01-23 19:45:11 +0000
commit8c684b90efa9d3d0e61b8d8136482cd7b5afc3a4 (patch)
tree3155eb5a64c9a07fd167dd8719526fc8648a3258
parent73b090736899e09dcfe6482da6e1e2f3a03ebc8b (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
-rw-r--r--Master/tlpkg/TeXLive/TLPOBJ.pm26
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm91
-rwxr-xr-xMaster/tlpkg/bin/tlprm77
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
&copy
&touch
+ &collapse_dirs
&install_package
&install_packages
&make_var_skeleton
@@ -845,10 +846,9 @@ sub copy {
}
-
=item C<touch(@files)>
-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<collapse_dirs(@files)>
+
+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<dir1/>, the result will be
+C</absolute/path/to/dir1>.
+
+=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<install_packages($from_tlpdb, $media, $to_tlpdb, $what, $opt_src, $opt_doc)>
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