bin/dircombine.real

   1 #!/home/james/.guix-profile/bin/perl
   2 # Uses symlinks to merge the files contained in a set of vcs
   3 # checkouts to into a single directory. Keeps track of when files are
   4 # removed from the merged directories and removes the symlinks.
   5 #
   6 # Only merges files that match the specified pattern.
   7 #
   8 # Note that the directories given to merge should be paths that will work
   9 # for symlink targets from the destination directory (so either full paths,
  10 # or they should be right inside the destination directory).
  11 #
  12 # Note that other files in the destination directory will be left as-is.
  13 #
  14 # Copyright 2006 by Joey Hess, licensed under the GPL.
  15
  16 if (! @ARGV) {
  17         die "usage: dircombine include-pattern dest dir1 [dir2 ...]\n";
  18 }
  19
  20 my $pattern=shift;
  21 my $dest=shift;
  22
  23 foreach my $dir (@ARGV) {
  24         my %known;
  25
  26         # Link in each thing from the dir.
  27         opendir(DIR, $dir) || die "opendir: $!";
  28         while ($_=readdir(DIR)) {
  29                 next if $_ eq '.' || $_ eq '..' || $_ eq 'known' || $_ eq '.svn' || $_ eq '.git' || $_ eq '.gitignore' || $_ eq '_darcs' || $_ eq '.fslckout' || $_ eq '.fossil-settings' || $_ eq '.ssh' || $_ eq '.config';
  30                 next unless /$pattern/;
  31
  32                 $known{$_}=1;
  33
  34                 if (! -l "$dest/$_" && -e "$dest/$_") {
  35                         print STDERR "$_ in $dir is also in $dest\n";
  36                 }
  37                 elsif (! -l "$dest/$_") {
  38                         system("ln", "$^O" ne "aix" ? "-svf" : "-sf", "$dir/$_", $dest);
  39                 }
  40         }
  41         closedir(DIR);
  42
  43         # Remove anything that was previously linked in but is not in the
  44         # dir anymore.
  45         if (-e "$dir/known") {
  46                 open(KNOWN, "$dir/known") || die "open $dir/known: $!";
  47                 while (<KNOWN>) {
  48                         chomp;
  49                         if (! $known{$_}) {
  50                                 system("rm", "$^O" ne "aix" ? "-vf" : "-f", "$dest/$_");
  51                         }
  52                 }
  53                 close KNOWN;
  54         }
  55
  56         # Save state for next time.
  57         open(KNOWN, ">$dir/known") || die "write $dir/known: $!";
  58         foreach my $file (sort keys %known) {
  59                 print KNOWN "$file\n";
  60         }
  61         close KNOWN;
  62 }