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