stow/t/dotfiles.t

236 lines
6.5 KiB
Perl
Raw Permalink Normal View History

#!/usr/bin/perl
#
# This file is part of GNU Stow.
#
# GNU Stow is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# GNU Stow is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see https://www.gnu.org/licenses/.
2016-07-31 16:55:55 -04:00
#
# Test case for dotfiles special processing
#
use strict;
use warnings;
use Test::More tests => 12;
2016-07-31 16:55:55 -04:00
use English qw(-no_match_vars);
use Stow::Util qw(adjust_dotfile unadjust_dotfile);
2016-07-31 16:55:55 -04:00
use testutil;
init_test_dirs();
cd("$TEST_DIR/target");
2016-07-31 16:55:55 -04:00
2024-03-31 18:51:14 -04:00
subtest('adjust_dotfile()', sub {
dotfiles: switch {un,}stow_{contents,node}() recursion parameters Stow walks the package and target tree hierarchies by using mutually recursive pairs of functions: - `stow_contents()` and `stow_node()` - `unstow_contents()` and `unstow_node()` As Stow runs its planning from the target directory (`plan_*()` both call `within_target_do()`), previously the parameters for these included: - `$target_subpath` (or `$target_subdir` in the `*_node()` functions): the relative path from the target top-level directory to the target subdirectory (initially `.` at the beginning of recursion). For example, this could be `dir1/subdir1/file1`. - `$source`: the relative path from the target _subdirectory_ (N.B. _not_ top-level directory) to the package subdirectory. For example, if the relative path to the Stow directory is `../stow`, this could be `../../../stow/pkg1/dir1/subdir1/file1`. This is used when stowing to construct a new link, or when unstowing to detect whether the link can be unstowed. Each time it descends into a further subdirectory of the target and package, it appends the new path segment onto both of these, and also prefixes `$source` with another `..`. When the `--dotfiles` parameter is enabled, it adjusts `$target_subdir`, performing the `dot-foo` => `.foo` adjustment on all segments of the path in one go. In this case, `$target_subpath` could be something like `.dir1/subdir1/file1`, and the corresponding `$source` could be something like `../../../stow/pkg1/dot-dir1/subdir1/file1`. However this doesn't leave an easy way to obtain the relative path from the target _top-level_ directory to the package subdirectory (i.e. `../stow/pkg1/dot-dir1/subdir1/file1`), which is needed for checking its existence and if necessary iterating over its contents. The current implementation solves this by including an extra `$level` parameter which tracks the recursion depth, and uses that to strip the right number of leading path segments off the front of `$source`. (In the above example, it would remove `../..`.) This implementation isn't the most elegant because: - It involves adding things to `$source` and then removing them again. - It performs the `dot-` => `.` adjustment on every path segment at each level, which is overkill, since when recursing down a level, only adjustment on the final subdirectory is required since the higher segments have already had any required adjustment. This in turn requires `adjust_dotfile` to be more complex than it needs to be. It also prevents a potential future where we might want Stow to optionally start iterating from within a subdirectory of the whole package install image / target tree, avoiding adjustment at higher levels and only doing it at the levels below the starting point. - It requires passing an extra `$level` parameter which can be automatically calculated simply by counting the number of slashes in `$target_subpath`. So change the `$source` recursion parameter to instead track the relative path from the top-level package directory to the package subdirectory or file being considered for (un)stowing, and rename it to avoid the ambiguity caused by the word "source". Also automatically calculate the depth simply by counting the number of slashes, and reconstruct `$source` when needed by combining the relative path to the Stow directory with the package name and `$target_subpath`. Closes #33.
2024-04-01 17:50:58 -04:00
plan tests => 4;
2024-03-31 18:51:14 -04:00
my @TESTS = (
['file'],
dotfiles: switch {un,}stow_{contents,node}() recursion parameters Stow walks the package and target tree hierarchies by using mutually recursive pairs of functions: - `stow_contents()` and `stow_node()` - `unstow_contents()` and `unstow_node()` As Stow runs its planning from the target directory (`plan_*()` both call `within_target_do()`), previously the parameters for these included: - `$target_subpath` (or `$target_subdir` in the `*_node()` functions): the relative path from the target top-level directory to the target subdirectory (initially `.` at the beginning of recursion). For example, this could be `dir1/subdir1/file1`. - `$source`: the relative path from the target _subdirectory_ (N.B. _not_ top-level directory) to the package subdirectory. For example, if the relative path to the Stow directory is `../stow`, this could be `../../../stow/pkg1/dir1/subdir1/file1`. This is used when stowing to construct a new link, or when unstowing to detect whether the link can be unstowed. Each time it descends into a further subdirectory of the target and package, it appends the new path segment onto both of these, and also prefixes `$source` with another `..`. When the `--dotfiles` parameter is enabled, it adjusts `$target_subdir`, performing the `dot-foo` => `.foo` adjustment on all segments of the path in one go. In this case, `$target_subpath` could be something like `.dir1/subdir1/file1`, and the corresponding `$source` could be something like `../../../stow/pkg1/dot-dir1/subdir1/file1`. However this doesn't leave an easy way to obtain the relative path from the target _top-level_ directory to the package subdirectory (i.e. `../stow/pkg1/dot-dir1/subdir1/file1`), which is needed for checking its existence and if necessary iterating over its contents. The current implementation solves this by including an extra `$level` parameter which tracks the recursion depth, and uses that to strip the right number of leading path segments off the front of `$source`. (In the above example, it would remove `../..`.) This implementation isn't the most elegant because: - It involves adding things to `$source` and then removing them again. - It performs the `dot-` => `.` adjustment on every path segment at each level, which is overkill, since when recursing down a level, only adjustment on the final subdirectory is required since the higher segments have already had any required adjustment. This in turn requires `adjust_dotfile` to be more complex than it needs to be. It also prevents a potential future where we might want Stow to optionally start iterating from within a subdirectory of the whole package install image / target tree, avoiding adjustment at higher levels and only doing it at the levels below the starting point. - It requires passing an extra `$level` parameter which can be automatically calculated simply by counting the number of slashes in `$target_subpath`. So change the `$source` recursion parameter to instead track the relative path from the top-level package directory to the package subdirectory or file being considered for (un)stowing, and rename it to avoid the ambiguity caused by the word "source". Also automatically calculate the depth simply by counting the number of slashes, and reconstruct `$source` when needed by combining the relative path to the Stow directory with the package name and `$target_subpath`. Closes #33.
2024-04-01 17:50:58 -04:00
['dot-'],
['dot-.'],
2024-03-31 18:51:14 -04:00
['dot-file', '.file'],
);
for my $test (@TESTS) {
my ($input, $expected) = @$test;
$expected ||= $input;
is(adjust_dotfile($input), $expected);
}
});
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);
}
});
2016-07-31 16:55:55 -04:00
my $stow;
subtest("stow dot-foo as .foo", sub {
2024-03-31 21:30:47 -04:00
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-foo');
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.foo'),
'../stow/dotfiles/dot-foo',
=> 'processed dotfile'
);
});
subtest("stow dot-foo as dot-foo without --dotfile enabled", sub {
2024-03-31 21:30:47 -04:00
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 0);
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-foo');
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('dot-foo'),
'../stow/dotfiles/dot-foo',
=> 'unprocessed dotfile'
);
});
subtest("stow dot-emacs dir as .emacs", sub {
2024-03-31 21:30:47 -04:00
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
2024-03-31 21:30:47 -04:00
make_path('../stow/dotfiles/dot-emacs');
make_file('../stow/dotfiles/dot-emacs/init.el');
2024-03-31 21:30:47 -04:00
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.emacs'),
'../stow/dotfiles/dot-emacs',
=> 'processed dotfile dir'
2024-03-31 21:30:47 -04:00
);
});
subtest("stow dir marked with 'dot' prefix when directory exists in target", sub {
2024-03-31 21:30:47 -04:00
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
2024-03-31 21:30:47 -04:00
make_path('../stow/dotfiles/dot-emacs.d');
make_file('../stow/dotfiles/dot-emacs.d/init.el');
make_path('.emacs.d');
2024-03-31 21:30:47 -04:00
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.emacs.d/init.el'),
'../../stow/dotfiles/dot-emacs.d/init.el',
=> 'processed dotfile dir when dir exists (1 level)'
2024-03-31 21:30:47 -04:00
);
});
subtest("stow dir marked with 'dot' prefix when directory exists in target (2 levels)", sub {
2024-03-31 21:30:47 -04:00
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
2024-03-31 21:30:47 -04:00
make_path('../stow/dotfiles/dot-emacs.d/dot-emacs.d');
make_file('../stow/dotfiles/dot-emacs.d/dot-emacs.d/init.el');
make_path('.emacs.d');
2024-03-31 21:30:47 -04:00
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('.emacs.d/.emacs.d'),
'../../stow/dotfiles/dot-emacs.d/dot-emacs.d',
=> 'processed dotfile dir exists (2 levels)'
2024-03-31 21:30:47 -04:00
);
});
subtest("stow dir marked with 'dot' prefix when directory exists in target", sub {
2024-03-31 21:30:47 -04:00
plan tests => 1;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
2024-03-31 21:30:47 -04:00
make_path('../stow/dotfiles/dot-one/dot-two');
make_file('../stow/dotfiles/dot-one/dot-two/three');
make_path('.one/.two');
2016-07-31 16:55:55 -04:00
2024-03-31 21:30:47 -04:00
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('./.one/.two/three'),
'../../../stow/dotfiles/dot-one/dot-two/three',
=> 'processed dotfile 2 dir exists (2 levels)'
2024-03-31 21:30:47 -04:00
);
2016-07-31 16:55:55 -04:00
2024-03-31 21:30:47 -04:00
});
2016-07-31 16:55:55 -04:00
2024-03-31 21:30:47 -04:00
subtest("dot-. should not have that part expanded.", sub {
plan tests => 2;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
2016-07-31 16:55:55 -04:00
2024-03-31 21:30:47 -04:00
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-');
2016-07-31 16:55:55 -04:00
2024-03-31 21:30:47 -04:00
make_path('../stow/dotfiles/dot-.');
make_file('../stow/dotfiles/dot-./foo');
2016-07-31 16:55:55 -04:00
2024-03-31 21:30:47 -04:00
$stow->plan_stow('dotfiles');
$stow->process_tasks();
is(
readlink('dot-'),
'../stow/dotfiles/dot-',
=> 'processed dotfile'
);
is(
readlink('dot-.'),
'../stow/dotfiles/dot-.',
=> 'unprocessed dotfile'
);
});
2016-07-31 16:55:55 -04:00
subtest("unstow .bar from dot-bar", sub {
2024-03-31 21:30:47 -04:00
plan tests => 3;
$stow = new_Stow(dir => '../stow', dotfiles => 1);
2016-07-31 16:55:55 -04:00
2024-03-31 21:30:47 -04:00
make_path('../stow/dotfiles');
make_file('../stow/dotfiles/dot-bar');
make_link('.bar', '../stow/dotfiles/dot-bar');
2024-03-31 21:30:47 -04:00
$stow->plan_unstow('dotfiles');
$stow->process_tasks();
is($stow->get_conflict_count, 0);
ok(-f '../stow/dotfiles/dot-bar', 'package file untouched');
ok(! -e '.bar' => '.bar was unstowed');
2024-03-31 21:30:47 -04:00
});
subtest("unstow dot-emacs.d/init.el when .emacs.d/init.el in target", sub {
2024-03-31 21:30:47 -04:00
plan tests => 4;
$stow = new_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');
});
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');
2024-03-31 21:30:47 -04:00
});