From 93fc195ddb5588a3ebeb4d353909b8e58e45bf0b Mon Sep 17 00:00:00 2001
From: Adam Spiers <stow@adamspiers.org>
Date: Sun, 7 Apr 2024 17:19:37 +0100
Subject: [PATCH] Fix unstowing with `--compat --dotfiles`

Unstowing with `--dotfiles` didn't work with `--compat`, because when
traversing the target tree rather than the package tree, there was no
mechanism for mapping a `.foo` file or directory back to its original
`dot-foo` and determine whether it should be unstowed.

So add a reverse `unadjust_dotfile()` mapping mechanism to support
this.
---
 lib/Stow.pm.in      | 27 ++++++++++++++++++++-------
 lib/Stow/Util.pm.in | 11 ++++++++++-
 t/dotfiles.t        | 42 +++++++++++++++++++++++++++++++++++++-----
 3 files changed, 67 insertions(+), 13 deletions(-)

diff --git a/lib/Stow.pm.in b/lib/Stow.pm.in
index 5a81855..b9b3b30 100755
--- a/lib/Stow.pm.in
+++ b/lib/Stow.pm.in
@@ -56,7 +56,8 @@ use File::Spec;
 use POSIX qw(getcwd);
 
 use Stow::Util qw(set_debug_level debug error set_test_mode
-                  join_paths restore_cwd canon_path parent adjust_dotfile);
+                  join_paths restore_cwd canon_path parent
+                  adjust_dotfile unadjust_dotfile);
 
 our $ProgramName = 'stow';
 our $VERSION = '@VERSION@';
@@ -801,12 +802,24 @@ sub unstow_contents {
         my $target_node = $node;
 
         if ($self->{dotfiles}) {
-            # $node is in the package tree, so adjust any dot-*
-            # files for the target.
-            my $adjusted = adjust_dotfile($node);
-            if ($adjusted ne $node) {
-                debug(4, 1, "Adjusting: $node => $adjusted");
-                $target_node = $adjusted;
+            if ($self->{compat}) {
+                # $node is in the target tree, so we need to reverse
+                # adjust any .* files in case they came from a dot-*
+                # file.
+                my $adjusted = unadjust_dotfile($node);
+                if ($adjusted ne $node) {
+                    debug(4, 1, "Reverse adjusting: $node => $adjusted");
+                    $package_node = $adjusted;
+                }
+            }
+            else {
+                # $node is in the package tree, so adjust any dot-*
+                # files for the target.
+                my $adjusted = adjust_dotfile($node);
+                if ($adjusted ne $node) {
+                    debug(4, 1, "Adjusting: $node => $adjusted");
+                    $target_node = $adjusted;
+                }
             }
         }
         my $package_node_path = join_paths($pkg_subdir, $package_node);
diff --git a/lib/Stow/Util.pm.in b/lib/Stow/Util.pm.in
index 8ee42f9..b33fb5a 100644
--- a/lib/Stow/Util.pm.in
+++ b/lib/Stow/Util.pm.in
@@ -38,7 +38,8 @@ use POSIX qw(getcwd);
 use base qw(Exporter);
 our @EXPORT_OK = qw(
     error debug set_debug_level set_test_mode
-    join_paths parent canon_path restore_cwd adjust_dotfile
+    join_paths parent canon_path restore_cwd
+    adjust_dotfile unadjust_dotfile
 );
 
 our $ProgramName = 'stow';
@@ -244,6 +245,14 @@ sub adjust_dotfile {
     return $adjusted;
 }
 
+# Needed when unstowing with --compat and --dotfiles
+sub unadjust_dotfile {
+    my ($target_node) = @_;
+    return $target_node if $target_node =~ /^\.\.?$/;
+    (my $adjusted = $target_node) =~ s/^\./dot-/;
+    return $adjusted;
+}
+
 =head1 BUGS
 
 =head1 SEE ALSO
diff --git a/t/dotfiles.t b/t/dotfiles.t
index 1c16522..643b873 100755
--- a/t/dotfiles.t
+++ b/t/dotfiles.t
@@ -22,10 +22,10 @@
 use strict;
 use warnings;
 
-use Test::More tests => 11;
+use Test::More tests => 12;
 use English qw(-no_match_vars);
 
-use Stow::Util qw(adjust_dotfile);
+use Stow::Util qw(adjust_dotfile unadjust_dotfile);
 use testutil;
 
 init_test_dirs();
@@ -46,6 +46,21 @@ subtest('adjust_dotfile()', sub {
     }
 });
 
+subtest('unadjust_dotfile()', sub {
+    plan tests => 4;
+    my @TESTS = (
+        ['file'],
+        ['.'],
+        ['..'],
+        ['.file', 'dot-file'],
+    );
+    for my $test (@TESTS) {
+        my ($input, $expected) = @$test;
+        $expected ||= $input;
+        is(unadjust_dotfile($input), $expected);
+    }
+});
+
 my $stow;
 
 subtest("stow dot-foo as .foo", sub {
@@ -182,7 +197,7 @@ subtest("unstow .bar from dot-bar", sub {
     $stow->process_tasks();
     is($stow->get_conflict_count, 0);
     ok(-f '../stow/dotfiles/dot-bar', 'package file untouched');
-    ok(! -e '.bar' => 'unstow a simple dotfile');
+    ok(! -e '.bar' => '.bar was unstowed');
 });
 
 subtest("unstow dot-emacs.d/init.el when .emacs.d/init.el in target", sub {
@@ -198,6 +213,23 @@ subtest("unstow dot-emacs.d/init.el when .emacs.d/init.el in target", sub {
     $stow->process_tasks();
     is($stow->get_conflict_count, 0);
     ok(-f '../stow/dotfiles/dot-emacs.d/init.el');
-    ok(! -e '.emacs.d/init.el');
-    ok(-d '.emacs.d/' => 'unstow dotfile dir when dir already exists');
+    ok(! -e '.emacs.d/init.el', '.emacs.d/init.el unstowed');
+    ok(-d '.emacs.d/' => '.emacs.d left behind');
+});
+
+subtest("unstow dot-emacs.d/init.el in --compat mode", sub {
+    plan tests => 4;
+    $stow = new_compat_Stow(dir => '../stow', dotfiles => 1);
+
+    make_path('../stow/dotfiles/dot-emacs.d');
+    make_file('../stow/dotfiles/dot-emacs.d/init.el');
+    make_path('.emacs.d');
+    make_link('.emacs.d/init.el', '../../stow/dotfiles/dot-emacs.d/init.el');
+
+    $stow->plan_unstow('dotfiles');
+    $stow->process_tasks();
+    is($stow->get_conflict_count, 0);
+    ok(-f '../stow/dotfiles/dot-emacs.d/init.el');
+    ok(! -e '.emacs.d/init.el', '.emacs.d/init.el unstowed');
+    ok(-d '.emacs.d/' => '.emacs.d left behind');
 });