Add --adopt / -a option.

2 files changed, 121 insertions, 11 deletions

diff --git a/t/stow_contents.t b/t/stow_contents.t
index 24e01dc..d4e66f0 100755
--- a/t/stow_contents.t
+++ b/t/stow_contents.t
@@ -7,7 +7,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 23;
+use Test::More tests => 35;
 use Test::Output;
 use English qw(-no_match_vars);
 
@@ -47,6 +47,7 @@ $stow = new_Stow();
 make_dir('../stow/pkg2/lib2');
 make_file('../stow/pkg2/lib2/file2');
 make_dir('lib2');
+
 $stow->plan_stow('pkg2');
 $stow->process_tasks();
 is( 
@@ -66,6 +67,7 @@ make_link('bin3' => '../stow/pkg3a/bin3'); # emulate stow
 
 make_dir('../stow/pkg3b/bin3');
 make_file('../stow/pkg3b/bin3/file3b');
+
 $stow->plan_stow('pkg3b');
 $stow->process_tasks();
 ok( 
@@ -76,22 +78,104 @@ ok(
 );
 
 #
-# Link to a new dir conflicts with existing non-dir (can't unfold)
+# Link to a new dir 'bin4' conflicts with existing non-dir so can't
+# unfold
 #
 $stow = new_Stow();
 
 make_file('bin4'); # this is a file but named like a directory
 make_dir('../stow/pkg4/bin4'); 
 make_file('../stow/pkg4/bin4/file4'); 
+
 $stow->plan_stow('pkg4');
 %conflicts = $stow->get_conflicts();
-like(
-    $conflicts{stow}{pkg4}[-1],
-    qr(existing target is neither a link nor a directory)
-    => 'link to new dir conflicts with existing non-directory'
+ok(
+    $stow->get_conflict_count == 1 &&
+    $conflicts{stow}{pkg4}[0] =~
+    qr/existing target is neither a link nor a directory/
+    => 'link to new dir bin4 conflicts with existing non-directory'
+);
+
+#
+# Link to a new dir 'bin4a' conflicts with existing non-dir so can't
+# unfold even with --adopt
+#
+#$stow = new_Stow(adopt => 1);
+$stow = new_Stow();
+
+make_file('bin4a'); # this is a file but named like a directory
+make_dir('../stow/pkg4a/bin4a'); 
+make_file('../stow/pkg4a/bin4a/file4a'); 
+
+$stow->plan_stow('pkg4a');
+%conflicts = $stow->get_conflicts();
+ok(
+    $stow->get_conflict_count == 1 &&
+    $conflicts{stow}{pkg4a}[0] =~ 
+    qr/existing target is neither a link nor a directory/
+    => 'link to new dir bin4a conflicts with existing non-directory'
 );
 
 #
+# Link to files 'file4b' and 'bin4b' conflict with existing files
+# without --adopt
+#
+$stow = new_Stow();
+
+# Populate target
+make_file('file4b',       'file4b - version originally in target');
+make_dir ('bin4b'); 
+make_file('bin4b/file4b', 'bin4b/file4b - version originally in target');
+
+# Populate
+make_dir ('../stow/pkg4b/bin4b'); 
+make_file('../stow/pkg4b/file4b',       'file4b - version originally in stow package');
+make_file('../stow/pkg4b/bin4b/file4b', 'bin4b/file4b - version originally in stow package');
+
+$stow->plan_stow('pkg4b');
+%conflicts = $stow->get_conflicts();
+is($stow->get_conflict_count, 2 => 'conflict per file');
+for my $i (0, 1) {
+    like(
+        $conflicts{stow}{pkg4b}[$i],
+        qr/existing target is neither a link nor a directory/
+        => 'link to file4b conflicts with existing non-directory'
+    );
+}
+
+#
+# Link to files 'file4b' and 'bin4b' do not conflict with existing
+# files when --adopt is given
+#
+$stow = new_Stow(adopt => 1);
+
+# Populate target
+make_file('file4c',       "file4c - version originally in target\n");
+make_dir ('bin4c'); 
+make_file('bin4c/file4c', "bin4c/file4c - version originally in target\n");
+
+# Populate
+make_dir ('../stow/pkg4c/bin4c'); 
+make_file('../stow/pkg4c/file4c',       "file4c - version originally in stow package\n");
+make_file('../stow/pkg4c/bin4c/file4c', "bin4c/file4c - version originally in stow package\n");
+
+$stow->plan_stow('pkg4c');
+is($stow->get_conflict_count, 0 => 'no conflicts with --adopt');
+my @tasks = $stow->get_tasks;
+is(@tasks, 4 => 'two tasks per file');
+$stow->process_tasks();
+for my $file ('file4c', 'bin4c/file4c') {
+    ok(-l $file, "$file turned into a symlink");
+    is(
+        readlink $file,
+        (index($file, '/') == -1 ? '' : '../' )
+        . "../stow/pkg4c/$file" => "$file points to right place"
+    );
+    is(cat_file($file), "$file - version originally in target\n" => "$file has right contents");
+}
+
+  
+#
 # Target already exists but is not owned by stow
 #
 $stow = new_Stow();
@@ -99,11 +183,12 @@ $stow = new_Stow();
 make_dir('bin5'); 
 make_link('bin5/file5','../../empty');
 make_dir('../stow/pkg5/bin5/file5'); 
+
 $stow->plan_stow('pkg5');
 %conflicts = $stow->get_conflicts();
 like( 
     $conflicts{stow}{pkg5}[-1],
-    qr(not owned by stow)
+    qr/not owned by stow/
     => 'target already exists but is not owned by stow'
 );
 
@@ -115,6 +200,7 @@ $stow = new_Stow();
 make_link('file6','../stow/path-does-not-exist');
 make_dir('../stow/pkg6');
 make_file('../stow/pkg6/file6');
+
 $stow->plan_stow('pkg6');
 $stow->process_tasks();
 is( 
@@ -135,11 +221,12 @@ make_file('../stow/pkg7a/bin7/node7');
 make_link('bin7/node7','../../stow/pkg7a/bin7/node7');
 make_dir('../stow/pkg7b/bin7/node7');
 make_file('../stow/pkg7b/bin7/node7/file7');
+
 $stow->plan_stow('pkg7b');
 %conflicts = $stow->get_conflicts();
 like(
     $conflicts{stow}{pkg7b}[-1],
-    qr(existing target is stowed to a different package)
+    qr/existing target is stowed to a different package/
     => 'link to new dir conflicts with existing stowed non-directory'
 );
 
@@ -154,6 +241,7 @@ make_link('0' => '../stow/pkg8a/0'); # emulate stow
 
 make_dir('../stow/pkg8b/0');
 make_file('../stow/pkg8b/0/file8b');
+
 $stow->plan_stow('pkg8b');
 $stow->process_tasks();
 ok( 
@@ -176,6 +264,7 @@ make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emu
 
 make_dir('../stow/pkg9b/man9/man1');
 make_file('../stow/pkg9b/man9/man1/file9.1');
+
 $stow->plan_stow('pkg9b');
 $stow->process_tasks();
 ok( 
@@ -196,8 +285,8 @@ make_link('man10/man1/file10.1' => '../../../stow/pkg10a/man10/man1/file10.1');
 
 make_dir('../stow/pkg10b/man10/man1');
 make_file('../stow/pkg10b/man10/man1/file10.1');
-$stow->plan_stow('pkg10b');
 
+$stow->plan_stow('pkg10b');
 stderr_like(
   sub { $stow->process_tasks(); },
   qr/There are no outstanding operations to perform/,
@@ -240,6 +329,7 @@ make_file('../stow/pkg12/lib12/lib.so');
 make_link('../stow/pkg12/lib12/lib.so.1','lib.so');
 
 make_dir('lib12/');
+
 $stow->plan_stow('pkg12');
 $stow->process_tasks();
 ok( 
@@ -347,3 +437,4 @@ is(
     '../stow/pkg18/bin18',
     => "minimal stow of a simple tree with absolute stow and target dirs"
 );
+
diff --git a/t/testutil.pm b/t/testutil.pm
index 67d4f45..97ac422 100755
--- a/t/testutil.pm
+++ b/t/testutil.pm
@@ -9,6 +9,8 @@ package testutil;
 use strict;
 use warnings;
 
+use File::Path qw(remove_tree);
+
 use Stow;
 use Stow::Util qw(parent canon_path);
 
@@ -20,13 +22,14 @@ our @EXPORT = qw(
     new_Stow new_compat_Stow
     make_dir make_link make_file
     remove_dir remove_link
+    cat_file
 );
 
 our $OUT_DIR = 'tmp-testing-trees';
 
 sub init_test_dirs {
     for my $dir ("$OUT_DIR/target", "$OUT_DIR/stow") {
-        -d $dir and remove_dir($dir);
+        -d $dir and remove_tree($dir);
         make_dir($dir);
     }
 
@@ -110,7 +113,7 @@ sub make_dir {
 # Comments  : detects clash with an existing non-file
 #============================================================================
 sub make_file {
-    my ($path, $contents) =@_;
+    my ($path, $contents) = @_;
 
     if (-e $path and ! -f $path) {
         die "a non-file already exists at $path\n";
@@ -210,6 +213,22 @@ sub cd {
     chdir $dir or die "Failed to chdir($dir): $!\n";
 }
 
+#===== SUBROUTINE ===========================================================
+# Name      : cat_file()
+# Purpose   : return file contents
+# Parameters: $file => file to read
+# Returns   : n/a
+# Throws    : fatal error if the open fails
+# Comments  : none
+#============================================================================
+sub cat_file {
+    my ($file) = @_;
+    open F, $file or die "Failed to open($file): $!\n";
+    my $contents = join '', <F>;
+    close(F);
+    return $contents;
+}
+
 1;
 
 # Local variables: