Implement the --orig command (#4)

bin/stow.in

@@ -203,6 +203,21 @@ stow directory, and then stowing proceeds as before.  So effectively,
 the file becomes adopted by the stow package, without its contents
 changing.
 
+=item --orig
+
+This option attempts to resolve simple file conflicts when stowing by retaining
+and restoring their '.orig' backups.
+
+When stowing, if a target is encountered which already exists but is a
+plain file, it is renamed with an additional '.orig' extension, and stowing
+proceeds. If a '.orig' file of the target already exists, a conflict is raised.
+The --adopt option overrides this behavior.
+
+When unstowing, the '.orig' backups are restored. If a '.orig' version of a
+target is encountered in the same dir, it is renamed to the target after unstowing the target.
+
+This option is not available in legacy mode (--compat).
+
 =item --no-folding
 
 Disable folding of newly stowed directories when stowing, and
@@ -576,7 +591,7 @@ sub parse_options {
         \%options,
         'verbose|v:+', 'help|h', 'simulate|n|no',
         'version|V', 'compat|p', 'dir|d=s', 'target|t=s',
-        'adopt', 'no-folding', 'dotfiles',
+        'adopt', 'orig', 'no-folding', 'dotfiles',
 
         # clean and pre-compile any regex's at parse time
         'ignore=s' =>
@@ -823,6 +838,9 @@ OPTIONS:
                           if the file is already stowed to another package
     --adopt               (Use with care!)  Import existing files into stow package
                           from target.  Please read docs before using.
+    --orig                If a conflicting file is encountered, retain a '.orig' copy
+                          of it and proceed instead of aborting. Note that the --adopt
+                          option overrides this behavior. See the docs for more info.
     --dotfiles            Enables special handling for dotfiles that are
                           Stow packages that start with "dot-" and not "."
     -p, --compat          Use legacy algorithm for unstowing

lib/Stow.pm.in

@@ -77,6 +77,7 @@ our %DEFAULT_OPTIONS = (
     test_mode    => 0,
     dotfiles     => 0,
     adopt        => 0,
+    orig         => 0,
     'no-folding' => 0,
     ignore       => [],
     override     => [],
@@ -117,6 +118,8 @@ See the documentation for the F<stow> CLI front-end for information on these.
 
 =item * adopt
 
+=item * orig
+
 =item * no-folding
 
 =item * ignore
@@ -538,6 +541,25 @@ sub stow_node {
                 $self->do_mv($target, $path);
                 $self->do_link($source, $target);
             }
+            elsif ($self->{orig}) {
+                my $orig_target = "$target.orig";
+
+                # Check if a backup already exists
+                if (-e $orig_target ) {
+                    $self->conflict(
+                        'stow',
+                        $package,
+                        "A conflicting .orig backup alread exists: $orig_target"
+                    );
+                }
+
+                # Back up the original with .orig extension
+                else {
+                    debug(4, "  Creating a .orig backup of a conflicting node: $orig_target");
+                    $self->do_mv($target, $orig_target);
+                    $self->do_link($source, $target);
+                }
+            }
             else {
                 $self->conflict(
                     'stow',
@@ -843,6 +865,13 @@ sub unstow_node {
 
             if ($existing_path eq $path) {
                 $self->do_unlink($target);
+
+                # If the original file was backed up with .orig, restore it
+                my $orig_target = "$target.orig";
+                if ($self->{orig} and -e $orig_target) {
+                    debug 3, "   Orig target $orig_target exists, restoring...";
+                    $self->do_mv($orig_target, $target);
+                }
             }
 
             # XXX we quietly ignore links that are stowed to a different

t/stow.t

@@ -22,7 +22,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 118;
+use Test::More tests => 127;
 use Test::Output;
 use English qw(-no_match_vars);
 
@@ -188,6 +188,50 @@ for my $file ('file4c', 'bin4c/file4c') {
     is(cat_file($file), "$file - version originally in target\n" => "$file has right contents");
 }
 
+#
+# Link to file 'file4d' conflict resolved when using --orig
+#
+$stow = new_Stow(orig => 1);
+
+make_file('file4d',               "file4d - version originally in target\n");
+make_path ('../stow/pkg4d');
+make_file('../stow/pkg4d/file4d', "file4d - version originally in stow package\n");
+
+$stow->plan_stow('pkg4d');
+
+is($stow->get_conflict_count, 0 => 'no conflicts with --orig');
+is($stow->get_tasks, 2 => 'two tasks per file');
+$stow->process_tasks();
+my $file = 'file4d';
+ok(-l $file, "$file turned into a symlink");
+ok(-e $file . '.orig', "$file got backed up with .orig");
+is(
+    readlink $file,
+    (index($file, '/') == -1 ? '' : '../' )
+    . "../stow/pkg4d/$file" => "$file points to right place"
+);
+is(cat_file($file), "$file - version originally in stow package\n" => "$file has right contents");
+is(cat_file($file . '.orig'), "$file - version originally in target\n" => "$file.orig has right contents");
+
+#
+# Link to file 'file4e' conflict with --orig when 'file4b.orig' already exists
+#
+$stow = new_Stow(orig => 1);
+
+make_file('file4e',               "file4e - version originally in target\n");
+make_file('file4e.orig',          "file4e.orig - version originally in target\n");
+make_path ('../stow/pkg4e');
+make_file('../stow/pkg4e/file4e', "file4e - version originally in stow package\n");
+
+$stow->plan_stow('pkg4e');
+
+is($stow->get_conflict_count, 1 => 'no conflicts with --orig');
+%conflicts = $stow->get_conflicts();
+like(
+    $conflicts{stow}{pkg4e}[0],
+    qr/A conflicting .orig backup alread exists/
+    => 'conflicted instead of backing up file4e because file4e.orig already existed'
+);
 
 #
 # Target already exists but is not owned by stow

t/unstow.t

@@ -22,7 +22,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 39;
+use Test::More tests => 43;
 use Test::Output;
 use English qw(-no_match_vars);
 
@@ -448,3 +448,22 @@ is_dir_not_symlink('no-folding-shared2/subdir');
 # Todo
 #
 # Test cleaning up subdirs with --paranoid option
+
+#
+# A file backup 'file4f.orig' is restored when using --orig with unstow
+#
+$stow = new_Stow(orig => 1);
+
+make_file('file16.orig',        "file16 - version originally in target\n");
+make_path ('../stow/pkg16');
+make_file('../stow/pkg16/file16', "file16 - version originally in stow package\n");
+make_link('file16', '../stow/pkg16/file16');
+
+$stow->plan_unstow('pkg16');
+is($stow->get_conflict_count, 0 => 'no conflicts unstowing with --orig');
+
+$stow->process_tasks();
+
+ok(-e 'file16', ".orig backup got restored");
+ok(! -e 'file16.orig', ".orig backup got deleted");
+is(cat_file('file16'), "file16 - version originally in target\n");