summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLUtils.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm91
1 files changed, 89 insertions, 2 deletions
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