From ed12c787df985896c8ba1c188af45b9fb637b017 Mon Sep 17 00:00:00 2001
From: Adam Spiers <stow@adamspiers.org>
Date: Sat, 18 Feb 2012 20:13:32 +0000
Subject: [PATCH] Add --no-folding option.

---
 NEWS           |   5 +++
 bin/stow.in    |   7 +++-
 doc/stow.texi  |  32 +++++++++++----
 lib/Stow.pm.in |  36 ++++++++++++-----
 t/stow.t       | 108 ++++++++++++++++++++++++++++++++++++++++++++++---
 t/testutil.pm  |  37 +++++++++++++++++
 t/unstow.t     |  85 +++++++++++++++++++++++++++++++++++++-
 7 files changed, 285 insertions(+), 25 deletions(-)

diff --git a/NEWS b/NEWS
index 8cfd33a..81be11e 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,11 @@ News file for Stow.
 
 * Changes in version 2.1.4
 
+** New --no-folding option
+
+   Disables folding of newly stowed directories when stowing, and
+   refolding of newly foldable directories when unstowing.
+
 ** Remove -a option (--adopt still available)
 
    As --adopt is the only option which allows stow to modify files, it
diff --git a/bin/stow.in b/bin/stow.in
index 45bc0f0..8d70f76 100755
--- a/bin/stow.in
+++ b/bin/stow.in
@@ -195,6 +195,11 @@ stow directory, and then stowing proceeds as before.  So effectively,
 the file becomes adopted by the stow package, without its contents
 changing.
 
+=item --no-folding
+
+Disable folding of newly stowed directories when stowing, and
+refolding of newly foldable directories when unstowing.
+
 =item --ignore=REGEX
 
 Ignore files ending in this Perl regex.
@@ -476,7 +481,7 @@ sub process_options {
         \%options,
         'verbose|v:+', 'help|h', 'simulate|n|no',
         'version|V', 'compat|p', 'dir|d=s', 'target|t=s',
-        'adopt',
+        'adopt', 'no-folding',
 
         # clean and pre-compile any regex's at parse time
         'ignore=s' =>
diff --git a/doc/stow.texi b/doc/stow.texi
index 2d042c3..d3b4423 100644
--- a/doc/stow.texi
+++ b/doc/stow.texi
@@ -327,6 +327,16 @@ pages that are owned by stow and would otherwise cause a conflict.
 The regular expression is anchored to the beginning of the path relative to
 the target directory, because this is what you will want to do most of the time.
 
+@item --no-folding
+
+This disables any further @ref{tree folding} or @ref{tree refolding}.
+If a new subdirectory is encountered whilst stowing a new package, the
+subdirectory is created within the target, and its contents are
+symlinked, rather than just creating a symlink for the directory.  If
+removal of symlinks whilst unstowing a package causes a subtree to be
+foldable (i.e. only containing symlinks to a single package), that
+subtree will not be removed and replaced with a symlink.
+
 @cindex adopting existing files
 @item --adopt
 @strong{Warning!} This behaviour is specifically intended to alter the
@@ -606,7 +616,8 @@ and it will descend into @file{/usr/local/lib} and create the
 tree-folding symlink @file{perl} pointing to
 @file{../stow/perl/lib/perl}, and so on.  As a rule, Stow only
 descends as far as necessary into the target tree when it can create a
-tree-folding symlink.
+tree-folding symlink.  However, this behaviour can be changed via
+the @option{--no-folding} option; @pxref{Invoking Stow}.
 
 @anchor{Tree unfolding}
 @section Tree unfolding
@@ -681,13 +692,20 @@ directory and a @file{man} directory at the top level, then we only scan
 @file{/usr/local/lib} or @file{/usr/local/share}, or for that matter
 @file{/usr/local/stow}.  Any symlink it finds that points into the package
 being deleted is removed.  Any directory that contained only symlinks to the
-package being deleted is removed.  Any directory that, after removing symlinks
-and empty subdirectories, contains only symlinks to a single other package, is
-considered to be a previously ``folded'' tree that was ``split open.''  Stow
-will re-fold the tree by removing the symlinks to the surviving package,
-removing the directory, then linking the directory back to the surviving
-package.
+package being deleted is removed.
 
+@anchor{tree refolding}
+@section Refolding ``foldable'' trees.
+@cindex refolding trees
+@cindex tree refolding
+
+After removing symlinks and empty subdirectories, any directory that
+contains only symlinks to a single other package is considered to be a
+previously ``folded'' tree that was ``split open.''  Stow will refold
+the tree by removing the symlinks to the surviving package, removing
+the directory, then linking the directory back to the surviving
+package.  However, this behaviour can be prevented via the
+@option{--no-folding} option; @pxref{Invoking Stow}.
 
 @c ===========================================================================
 @node Conflicts, Mixing Operations, Deleting Packages, Top
diff --git a/lib/Stow.pm.in b/lib/Stow.pm.in
index 7ef1828..101a422 100755
--- a/lib/Stow.pm.in
+++ b/lib/Stow.pm.in
@@ -54,16 +54,17 @@ our @default_global_ignore_regexps =
 
 # These are the default options for each Stow instance.
 our %DEFAULT_OPTIONS = (
-    conflicts  => 0,
-    simulate   => 0,
-    verbose    => 0,
-    paranoid   => 0,
-    compat     => 0,
-    test_mode  => 0,
-    adopt      => 0,
-    ignore     => [],
-    override   => [],
-    defer      => [],
+    conflicts    => 0,
+    simulate     => 0,
+    verbose      => 0,
+    paranoid     => 0,
+    compat       => 0,
+    test_mode    => 0,
+    adopt        => 0,
+    'no-folding' => 0,
+    ignore       => [],
+    override     => [],
+    defer        => [],
 );
 
 =head1 CONSTRUCTORS
@@ -100,6 +101,8 @@ See the documentation for the F<stow> CLI front-end for information on these.
 
 =item * adopt
 
+=item * no-folding
+
 =item * ignore
 
 =item * override
@@ -517,6 +520,15 @@ sub stow_node {
             }
         }
     }
+    elsif ($self->{'no-folding'} && -d $path) {
+        $self->do_mkdir($target);
+        $self->stow_contents(
+            $self->{stow_path},
+            $package,
+            $target,
+            join_paths('..', $source),
+        );
+    }
     else {
         $self->do_link($source, $target);
     }
@@ -994,6 +1006,10 @@ sub foldable {
     my ($target) = @_;
 
     debug(3, "--- Is $target foldable?");
+    if ($self->{'no-folding'}) {
+        debug(3, "--- no because --no-folding enabled");
+        return '';
+    }
 
     opendir my $DIR, $target
         or error(qq{Cannot read directory "$target" ($!)\n});
diff --git a/t/stow.t b/t/stow.t
index 0786d18..ccad54d 100755
--- a/t/stow.t
+++ b/t/stow.t
@@ -7,7 +7,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 35;
+use Test::More tests => 111;
 use Test::Output;
 use English qw(-no_match_vars);
 
@@ -32,7 +32,7 @@ make_file('../stow/pkg1/bin1/file1');
 
 $stow->plan_stow('pkg1');
 $stow->process_tasks();
-is($stow->get_conflicts(), 0, 'no conflicts with minimal stow');
+is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
 is( 
     readlink('bin1'),  
     '../stow/pkg1/bin1', 
@@ -387,7 +387,7 @@ make_file("$OUT_DIR/stow/pkg16/bin16/file16");
 
 $stow->plan_stow('pkg16');
 $stow->process_tasks();
-is($stow->get_conflicts(), 0, 'no conflicts with minimal stow');
+is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
 is(
     readlink("$OUT_DIR/target/bin16"),
     '../stow/pkg16/bin16',
@@ -406,7 +406,7 @@ make_file("$OUT_DIR/stow/pkg17/bin17/file17");
 
 $stow->plan_stow('pkg17');
 $stow->process_tasks();
-is($stow->get_conflicts(), 0, 'no conflicts with minimal stow');
+is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
 is(
     readlink("$OUT_DIR/target/bin17"),
     '../stow/pkg17/bin17',
@@ -425,10 +425,108 @@ make_file("$OUT_DIR/stow/pkg18/bin18/file18");
 
 $stow->plan_stow('pkg18');
 $stow->process_tasks();
-is($stow->get_conflicts(), 0, 'no conflicts with minimal stow');
+is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
 is(
     readlink("$OUT_DIR/target/bin18"),
     '../stow/pkg18/bin18',
     => "minimal stow of a simple tree with absolute stow and target dirs"
 );
 
+#
+# stow a tree with no-folding enabled -
+# no new folded directories should be created, and existing
+# folded directories should be split open (unfolded) where
+# (and only where) necessary
+#
+cd("$OUT_DIR/target");
+
+sub create_pkg {
+    my ($id, $pkg) = @_;
+
+    my $stow_pkg = "../stow/$id-$pkg";
+    make_dir ($stow_pkg);
+    make_file("$stow_pkg/$id-file-$pkg");
+
+    # create a shallow hierarchy specific to this package which isn't
+    # yet stowed
+    make_dir ("$stow_pkg/$id-$pkg-only-new");
+    make_file("$stow_pkg/$id-$pkg-only-new/$id-file-$pkg");
+
+    # create a deeper hierarchy specific to this package which isn't
+    # yet stowed
+    make_dir ("$stow_pkg/$id-$pkg-only-new2/subdir");
+    make_file("$stow_pkg/$id-$pkg-only-new2/subdir/$id-file-$pkg");
+
+    # create a hierarchy specific to this package which is already
+    # stowed via a folded tree
+    make_dir ("$stow_pkg/$id-$pkg-only-old");
+    make_link("$id-$pkg-only-old", "$stow_pkg/$id-$pkg-only-old");
+    make_file("$stow_pkg/$id-$pkg-only-old/$id-file-$pkg");
+
+    # create a shared hierarchy which this package uses
+    make_dir ("$stow_pkg/$id-shared");
+    make_file("$stow_pkg/$id-shared/$id-file-$pkg");
+
+    # create a partially shared hierarchy which this package uses
+    make_dir ("$stow_pkg/$id-shared2/subdir-$pkg");
+    make_file("$stow_pkg/$id-shared2/$id-file-$pkg");
+    make_file("$stow_pkg/$id-shared2/subdir-$pkg/$id-file-$pkg");
+}
+
+foreach my $pkg (qw{a b}) {
+    create_pkg('no-folding', $pkg);
+}
+
+$stow = new_Stow('no-folding' => 1);
+$stow->plan_stow('no-folding-a');
+is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
+my @tasks = $stow->get_tasks;
+use Data::Dumper;
+is(scalar(@tasks), 12 => "6 dirs, 6 links") || warn Dumper(\@tasks);
+$stow->process_tasks();
+
+sub check_no_folding {
+    my ($pkg) = @_;
+    my $stow_pkg = "../stow/no-folding-$pkg";
+    is_link("no-folding-file-$pkg", "$stow_pkg/no-folding-file-$pkg");
+
+    # check existing folded tree is untouched
+    is_link("no-folding-$pkg-only-old", "$stow_pkg/no-folding-$pkg-only-old");
+
+    # check newly stowed shallow tree is not folded
+    is_dir_not_symlink("no-folding-$pkg-only-new");
+    is_link("no-folding-$pkg-only-new/no-folding-file-$pkg",
+            "../$stow_pkg/no-folding-$pkg-only-new/no-folding-file-$pkg");
+
+    # check newly stowed deeper tree is not folded
+    is_dir_not_symlink("no-folding-$pkg-only-new2");
+    is_dir_not_symlink("no-folding-$pkg-only-new2/subdir");
+    is_link("no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg",
+            "../../$stow_pkg/no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg");
+
+    # check shared tree is not folded. first time round this will be
+    # newly stowed.
+    is_dir_not_symlink('no-folding-shared');
+    is_link("no-folding-shared/no-folding-file-$pkg",
+            "../$stow_pkg/no-folding-shared/no-folding-file-$pkg");
+
+    # check partially shared tree is not folded. first time round this
+    # will be newly stowed.
+    is_dir_not_symlink('no-folding-shared2');
+    is_link("no-folding-shared2/no-folding-file-$pkg",
+            "../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
+    is_link("no-folding-shared2/no-folding-file-$pkg",
+            "../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
+}
+
+check_no_folding('a');
+
+$stow = new_Stow('no-folding' => 1);
+$stow->plan_stow('no-folding-b');
+is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
+@tasks = $stow->get_tasks;
+is(scalar(@tasks), 10 => '4 dirs, 6 links') || warn Dumper(\@tasks);
+$stow->process_tasks();
+
+check_no_folding('a');
+check_no_folding('b');
diff --git a/t/testutil.pm b/t/testutil.pm
index 9e4573b..b9359be 100755
--- a/t/testutil.pm
+++ b/t/testutil.pm
@@ -13,6 +13,7 @@ use Carp qw(croak);
 use File::Basename;
 use File::Path qw(remove_tree);
 use File::Spec;
+use Test::More;
 
 use Stow;
 use Stow::Util qw(parent canon_path);
@@ -26,6 +27,7 @@ our @EXPORT = qw(
     make_dir make_link make_invalid_link make_file
     remove_dir remove_link
     cat_file
+    is_link is_dir_not_symlink is_nonexistent_path
 );
 
 our $OUT_DIR = 'tmp-testing-trees';
@@ -254,6 +256,41 @@ sub cat_file {
     return $contents;
 }
 
+#===== SUBROUTINE ===========================================================
+# Name      : is_link()
+# Purpose   : assert path is a symlink
+# Parameters: $path => path to check
+#           : $dest => target symlink should point to
+#============================================================================
+sub is_link {
+    my ($path, $dest) = @_;
+    ok(-l $path => "$path should be symlink");
+    is(readlink $path, $dest => "$path symlinks to $dest");
+}
+
+#===== SUBROUTINE ===========================================================
+# Name      : is_dir_not_symlink()
+# Purpose   : assert path is a directory not a symlink
+# Parameters: $path => path to check
+#============================================================================
+sub is_dir_not_symlink {
+    my ($path) = @_;
+    ok(! -l $path => "$path should not be symlink");
+    ok(-d _       => "$path should be a directory");
+}
+
+#===== SUBROUTINE ===========================================================
+# Name      : is_nonexistent_path()
+# Purpose   : assert path does not exist
+# Parameters: $path => path to check
+#============================================================================
+sub is_nonexistent_path {
+    my ($path) = @_;
+    ok(! -l $path => "$path should not be symlink");
+    ok(! -e _     => "$path should not exist");
+}
+
+
 1;
 
 # Local variables:
diff --git a/t/unstow.t b/t/unstow.t
index bf46bfa..d166107 100755
--- a/t/unstow.t
+++ b/t/unstow.t
@@ -7,7 +7,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 23;
+use Test::More tests => 38;
 use Test::Output;
 use English qw(-no_match_vars);
 
@@ -341,8 +341,89 @@ ok(
     => 'unstow a simple tree with absolute stow and target dirs'
 );
 
+#
+# unstow a tree with no-folding enabled -
+# no refolding should take place
+#
+cd("$OUT_DIR/target");
+
+sub create_and_stow_pkg {
+    my ($id, $pkg) = @_;
+
+    my $stow_pkg = "../stow/$id-$pkg";
+    make_dir ($stow_pkg);
+    make_file("$stow_pkg/$id-file-$pkg");
+
+    # create a shallow hierarchy specific to this package and stow
+    # via folding
+    make_dir ("$stow_pkg/$id-$pkg-only-folded");
+    make_file("$stow_pkg/$id-$pkg-only-folded/file-$pkg");
+    make_link("$id-$pkg-only-folded", "$stow_pkg/$id-$pkg-only-folded");
+
+    # create a deeper hierarchy specific to this package and stow
+    # via folding
+    make_dir ("$stow_pkg/$id-$pkg-only-folded2/subdir");
+    make_file("$stow_pkg/$id-$pkg-only-folded2/subdir/file-$pkg");
+    make_link("$id-$pkg-only-folded2",
+              "$stow_pkg/$id-$pkg-only-folded2");
+
+    # create a shallow hierarchy specific to this package and stow
+    # without folding
+    make_dir ("$stow_pkg/$id-$pkg-only-unfolded");
+    make_file("$stow_pkg/$id-$pkg-only-unfolded/file-$pkg");
+    make_dir ("$id-$pkg-only-unfolded");
+    make_link("$id-$pkg-only-unfolded/file-$pkg",
+              "../$stow_pkg/$id-$pkg-only-unfolded/file-$pkg");
+
+    # create a deeper hierarchy specific to this package and stow
+    # without folding
+    make_dir ("$stow_pkg/$id-$pkg-only-unfolded2/subdir");
+    make_file("$stow_pkg/$id-$pkg-only-unfolded2/subdir/file-$pkg");
+    make_dir ("$id-$pkg-only-unfolded2/subdir");
+    make_link("$id-$pkg-only-unfolded2/subdir/file-$pkg",
+              "../../$stow_pkg/$id-$pkg-only-unfolded2/subdir/file-$pkg");
+
+    # create a shallow shared hierarchy which this package uses, and stow
+    # its contents without folding
+    make_dir ("$stow_pkg/$id-shared");
+    make_file("$stow_pkg/$id-shared/file-$pkg");
+    make_dir ("$id-shared");
+    make_link("$id-shared/file-$pkg",
+              "../$stow_pkg/$id-shared/file-$pkg");
+
+    # create a deeper shared hierarchy which this package uses, and stow
+    # its contents without folding
+    make_dir ("$stow_pkg/$id-shared2/subdir");
+    make_file("$stow_pkg/$id-shared2/file-$pkg");
+    make_file("$stow_pkg/$id-shared2/subdir/file-$pkg");
+    make_dir ("$id-shared2/subdir");
+    make_link("$id-shared2/file-$pkg",
+              "../$stow_pkg/$id-shared2/file-$pkg");
+    make_link("$id-shared2/subdir/file-$pkg",
+              "../../$stow_pkg/$id-shared2/subdir/file-$pkg");
+}
+
+foreach my $pkg (qw{a b}) {
+    create_and_stow_pkg('no-folding', $pkg);
+}
+
+$stow = new_Stow('no-folding' => 1);
+$stow->plan_unstow('no-folding-b');
+is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
+use Data::Dumper;
+#warn Dumper($stow->get_tasks);
+
+$stow->process_tasks();
+
+is_nonexistent_path('no-folding-b-only-folded');
+is_nonexistent_path('no-folding-b-only-folded2');
+is_nonexistent_path('no-folding-b-only-unfolded/file-b');
+is_nonexistent_path('no-folding-b-only-unfolded2/subdir/file-b');
+is_dir_not_symlink('no-folding-shared');
+is_dir_not_symlink('no-folding-shared2');
+is_dir_not_symlink('no-folding-shared2/subdir');
+
 
 # Todo
 #
 # Test cleaning up subdirs with --paranoid option
-