From 59778b95967497a852b3afc52b186eb77eb0ceca Mon Sep 17 00:00:00 2001
From: adam <adam>
Date: Mon, 2 Jan 2006 01:48:25 +0000
Subject: [PATCH] -p for pruning

---
 Stow.pm | 23 ++++++++++++++++++++---
 stow.in | 30 ++++++++++++++++++++++++------
 2 files changed, 44 insertions(+), 9 deletions(-)

diff --git a/Stow.pm b/Stow.pm
index 3637b86..9dc4910 100755
--- a/Stow.pm
+++ b/Stow.pm
@@ -141,8 +141,8 @@ sub JoinPaths {
 
 sub Unstow {
   my($targetdir, $stow, $PkgsToUnstow) = @_;
-  # Note $targetdir is relative to the top of the target hierarchy,
-  # i.e. $opts{target}.
+  # $targetdir is the directory we're unstowing in, relative to the
+  # top of the target hierarchy, i.e. $opts{target}.
   #
   # $stow is the stow directory (the one containing the source
   # packages), and is always relative to $targetdir.  So as we
@@ -227,7 +227,7 @@ sub Unstow {
 	$pure = 0;
       }
     }
-    elsif (-d $contentPath) {
+    elsif (-d $contentPath && ! &PruneTree($targetdir, $content, $PkgsToUnstow)) {
       # recurse
       my ($subpure, $subother) = &Unstow(
         &JoinPaths($targetdir, $content),
@@ -272,6 +272,23 @@ sub Unstow {
   return ($pure, $othercollection);
 }
 
+sub PruneTree {
+  my ($targetdir, $subdir, $PkgsToUnstow) = @_;
+
+  return 0 unless $opts{prune};
+  my $relpath = &JoinPaths($targetdir, $subdir);
+
+  foreach my $pkg (keys %$PkgsToUnstow) {
+    my $abspath = &JoinPaths($opts{stow}, $pkg, $relpath);
+    if (-d $abspath) {
+      warn "# Not pruning $relpath since -d $abspath\n" if $opts{verbose} > 4;
+      return 0;
+    }
+  }
+  warn "# Pruning $relpath\n" if $opts{verbose} > 2;
+  return 1;
+}
+
 # This is the tree folding which the stow manual refers to.
 sub CoalesceTrees {
   my($parent, $stow, @trees) = @_;
diff --git a/stow.in b/stow.in
index fdfd773..19ded10 100755
--- a/stow.in
+++ b/stow.in
@@ -45,11 +45,12 @@ use Sh 'glob_to_re';
 use Stow;
 
 my $ignore_file = File::Spec->join($ENV{HOME}, ".cvsignore");
-my $ignore_re = get_ignore_re_from_file($ignore_file);
+my $ignore_re = Stow::get_ignore_re_from_file($ignore_file);
 
 my %opts = (
   conflicts  => 0, 
   delete     => 0, 
+  prune      => 0, 
   not_really => 0, 
   verbose    => 0, 
   stow       => undef, 
@@ -57,16 +58,21 @@ my %opts = (
   restow     => 0, 
 );
 
+Getopt::Long::Configure('noignorecase', 'bundling');
 GetOptions(
   \%opts,
-  'conflicts|c', 'not_really|n', 'stow|dir|d=s', 'target|t=s',
-  'verbose|v:+', 'delete|D', 'version|V', 'help|h',
+  'delete|D', 'prune|p', 'restow|R',
+  'conflicts|c', 'not_really|n',
+  'stow|dir|d=s', 'target|t=s',
+  'verbose|v:+', 'version|V', 'help|h',
 )
 or usage();
 
 version() if $opts{version};
 usage()   if $opts{help};
 
+usage("Pruning only makes sense when deleting or restowing")
+  if $opts{prune} and ! ($opts{delete} || $opts{restow});
 usage("No packages named") unless @ARGV;
 
 Stow::SetOptions(%opts);
@@ -76,13 +82,23 @@ my @Collections = @ARGV;
 Stow::CheckCollections(@Collections);
 
 if ($opts{delete} || $opts{restow}) {
-  Stow::Unstow('', &RelativePath($opts{target}, $opts{stow}), \@Collections);
+  # These are the packages we are unstowing.
+  my %to_unstow = map { $_ => 1 } @Collections;
+
+  Stow::Unstow(
+    '',
+    Stow::RelativePath($opts{target}, $opts{stow}),
+    \%to_unstow,
+  );
 }
 
-if (!$opts{delete} || $opts{restow}) {
+if (! $opts{delete} || $opts{restow}) {
   foreach my $Collection (@ARGV) {
     warn "Stowing package $Collection...\n" if $opts{verbose};
-    Stow::StowContents($Collection, &RelativePath($opts{target}, $opts{stow}));
+    Stow::StowContents(
+      $Collection,
+      Stow::RelativePath($opts{target}, $opts{stow}),
+    );
   }
 }
 
@@ -104,6 +120,8 @@ sub usage {
                           -v or --verbose adds 1; --verbose=N sets level)
   -D, --delete          Unstow instead of stow
   -R, --restow          Restow (like stow -D followed by stow)
+  -p, --prune           When deleting, skip target subdirectories not in
+                        the package dir (faster but may leave symlinks)
   -V, --version         Show Stow version number
   -h, --help            Show this help
 EOT