00dani/stow
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Fix unstowing with --compat --dotfiles

Browse source 
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.
This commit is contained in:
Adam Spiers 2024-04-07 17:19:37 +01:00
parent 723ddcf3a4
commit 93fc195ddb
3 changed files with 67 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
lib/Stow.pm.in
View file

@ -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);

11
lib/Stow/Util.pm.in
View file

@ -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

42
t/dotfiles.t
View file

@ -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');
});