t/unstow.t

   1 #!/usr/bin/perl
   2 #
   3 # This file is part of GNU Stow.
   4 #
   5 # GNU Stow is free software: you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation, either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # GNU Stow is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program. If not, see https://www.gnu.org/licenses/.
  17
  18 #
  19 # Test unstowing packages
  20 #
  21
  22 use strict;
  23 use warnings;
  24
  25 use Test::More tests => 32;
  26 use Test::Output;
  27 use English qw(-no_match_vars);
  28
  29 use testutil;
  30 use Stow::Util qw(canon_path);
  31
  32 init_test_dirs();
  33 cd("$TEST_DIR/target");
  34
  35 # Note that each of the following tests use a distinct set of files
  36
  37 subtest("unstow a simple tree minimally", sub {
  38     plan tests => 3;
  39     my $stow = new_Stow();
  40
  41     make_path('../stow/pkg1/bin1');
  42     make_file('../stow/pkg1/bin1/file1');
  43     make_link('bin1', '../stow/pkg1/bin1');
  44
  45     $stow->plan_unstow('pkg1');
  46     $stow->process_tasks();
  47     is($stow->get_conflict_count, 0);
  48     ok(-f '../stow/pkg1/bin1/file1');
  49     ok(! -e 'bin1' => 'unstow a simple tree');
  50 });
  51
  52 subtest("unstow a simple tree from an existing directory", sub {
  53     plan tests => 3;
  54     my $stow = new_Stow();
  55
  56     make_path('lib2');
  57     make_path('../stow/pkg2/lib2');
  58     make_file('../stow/pkg2/lib2/file2');
  59     make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
  60     $stow->plan_unstow('pkg2');
  61     $stow->process_tasks();
  62     is($stow->get_conflict_count, 0);
  63     ok(-f '../stow/pkg2/lib2/file2');
  64     ok(-d 'lib2'
  65         => 'unstow simple tree from a pre-existing directory'
  66     );
  67 });
  68
  69 subtest("fold tree after unstowing", sub {
  70     plan tests => 3;
  71     my $stow = new_Stow();
  72
  73     make_path('bin3');
  74
  75     make_path('../stow/pkg3a/bin3');
  76     make_file('../stow/pkg3a/bin3/file3a');
  77     make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
  78
  79     make_path('../stow/pkg3b/bin3');
  80     make_file('../stow/pkg3b/bin3/file3b');
  81     make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
  82     $stow->plan_unstow('pkg3b');
  83     $stow->process_tasks();
  84     is($stow->get_conflict_count, 0);
  85     ok(-l 'bin3');
  86     is(readlink('bin3'), '../stow/pkg3a/bin3'
  87         => 'fold tree after unstowing'
  88     );
  89 });
  90
  91 subtest("existing link is owned by stow but is invalid so it gets removed anyway", sub {
  92     plan tests => 2;
  93     my $stow = new_Stow();
  94
  95     make_path('bin4');
  96     make_path('../stow/pkg4/bin4');
  97     make_file('../stow/pkg4/bin4/file4');
  98     make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
  99
 100     $stow->plan_unstow('pkg4');
 101     $stow->process_tasks();
 102     is($stow->get_conflict_count, 0);
 103     ok(! -e 'bin4/file4'
 104         => q(remove invalid link owned by stow)
 105     );
 106 });
 107
 108 subtest("Existing link is not owned by stow", sub {
 109     plan tests => 1;
 110     my $stow = new_Stow();
 111
 112     make_path('../stow/pkg5/bin5');
 113     make_invalid_link('bin5', '../not-stow');
 114
 115     $stow->plan_unstow('pkg5');
 116     my %conflicts = $stow->get_conflicts;
 117     like(
 118         $conflicts{unstow}{pkg5}[-1],
 119         qr(existing target is not owned by stow)
 120         => q(existing link not owned by stow)
 121     );
 122 });
 123
 124 subtest("Target already exists, is owned by stow, but points to a different package", sub {
 125     plan tests => 3;
 126     my $stow = new_Stow();
 127
 128     make_path('bin6');
 129     make_path('../stow/pkg6a/bin6');
 130     make_file('../stow/pkg6a/bin6/file6');
 131     make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
 132
 133     make_path('../stow/pkg6b/bin6');
 134     make_file('../stow/pkg6b/bin6/file6');
 135
 136     $stow->plan_unstow('pkg6b');
 137     is($stow->get_conflict_count, 0);
 138     ok(-l 'bin6/file6');
 139     is(
 140         readlink('bin6/file6'),
 141         '../../stow/pkg6a/bin6/file6'
 142         => q(ignore existing link that points to a different package)
 143     );
 144 });
 145
 146 subtest("Don't unlink anything under the stow directory", sub {
 147     plan tests => 4;
 148     make_path('stow'); # make out stow dir a subdir of target
 149     my $stow = new_Stow(dir => 'stow');
 150
 151     # emulate stowing into ourself (bizarre corner case or accident)
 152     make_path('stow/pkg7a/stow/pkg7b');
 153     make_file('stow/pkg7a/stow/pkg7b/file7b');
 154     make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
 155
 156     $stow->plan_unstow('pkg7b');
 157     is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
 158     is($stow->get_conflict_count, 0);
 159     ok(-l 'stow/pkg7b');
 160     is(
 161         readlink('stow/pkg7b'),
 162         '../stow/pkg7a/stow/pkg7b'
 163         => q(don't unlink any nodes under the stow directory)
 164     );
 165 });
 166
 167 subtest("Don't unlink any nodes under another stow directory", sub {
 168     plan tests => 5;
 169     my $stow = new_Stow(dir => 'stow');
 170
 171     make_path('stow2'); # make our alternate stow dir a subdir of target
 172     make_file('stow2/.stow');
 173
 174     # emulate stowing into ourself (bizarre corner case or accident)
 175     make_path('stow/pkg8a/stow2/pkg8b');
 176     make_file('stow/pkg8a/stow2/pkg8b/file8b');
 177     make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
 178
 179     stderr_like(
 180         sub { $stow->plan_unstow('pkg8a'); },
 181         qr/WARNING: skipping marked Stow directory stow2/
 182         => "unstowing from ourself should skip stow"
 183     );
 184     is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
 185     is($stow->get_conflict_count, 0);
 186     ok(-l 'stow2/pkg8b');
 187     is(
 188         readlink('stow2/pkg8b'),
 189         '../stow/pkg8a/stow2/pkg8b'
 190         => q(don't unlink any nodes under another stow directory)
 191     );
 192 });
 193
 194 subtest("overriding already stowed documentation", sub {
 195     plan tests => 2;
 196     my $stow = new_Stow(override => ['man9', 'info9']);
 197     make_file('stow/.stow');
 198
 199     make_path('../stow/pkg9a/man9/man1');
 200     make_file('../stow/pkg9a/man9/man1/file9.1');
 201     make_path('man9/man1');
 202     make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
 203
 204     make_path('../stow/pkg9b/man9/man1');
 205     make_file('../stow/pkg9b/man9/man1/file9.1');
 206     $stow->plan_unstow('pkg9b');
 207     $stow->process_tasks();
 208     is($stow->get_conflict_count, 0);
 209     ok(!-l 'man9/man1/file9.1'
 210         => 'overriding existing documentation files'
 211     );
 212 });
 213
 214 subtest("deferring to already stowed documentation", sub {
 215     plan tests => 3;
 216     my $stow = new_Stow(defer => ['man10', 'info10']);
 217
 218     make_path('../stow/pkg10a/man10/man1');
 219     make_file('../stow/pkg10a/man10/man1/file10a.1');
 220     make_path('man10/man1');
 221     make_link('man10/man1/file10a.1'  => '../../../stow/pkg10a/man10/man1/file10a.1');
 222
 223     # need this to block folding
 224     make_path('../stow/pkg10b/man10/man1');
 225     make_file('../stow/pkg10b/man10/man1/file10b.1');
 226     make_link('man10/man1/file10b.1'  => '../../../stow/pkg10b/man10/man1/file10b.1');
 227
 228
 229     make_path('../stow/pkg10c/man10/man1');
 230     make_file('../stow/pkg10c/man10/man1/file10a.1');
 231     $stow->plan_unstow('pkg10c');
 232     is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
 233     is($stow->get_conflict_count, 0);
 234     is(
 235         readlink('man10/man1/file10a.1'),
 236         '../../../stow/pkg10a/man10/man1/file10a.1'
 237         => 'defer to existing documentation files'
 238     );
 239 });
 240
 241 subtest("Ignore temp files", sub {
 242     plan tests => 2;
 243     my $stow = new_Stow(ignore => ['~', '\.#.*']);
 244
 245     make_path('../stow/pkg12/man12/man1');
 246     make_file('../stow/pkg12/man12/man1/file12.1');
 247     make_file('../stow/pkg12/man12/man1/file12.1~');
 248     make_file('../stow/pkg12/man12/man1/.#file12.1');
 249     make_path('man12/man1');
 250     make_link('man12/man1/file12.1'  => '../../../stow/pkg12/man12/man1/file12.1');
 251
 252     $stow->plan_unstow('pkg12');
 253     $stow->process_tasks();
 254     is($stow->get_conflict_count, 0);
 255     ok(!-e 'man12/man1/file12.1' => 'ignore temp files');
 256 });
 257
 258 subtest("Unstow an already unstowed package", sub {
 259     plan tests => 2;
 260     my $stow = new_Stow();
 261     $stow->plan_unstow('pkg12');
 262     is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
 263     is(
 264         $stow->get_conflict_count, 0
 265         => 'unstow already unstowed package pkg12'
 266     );
 267 });
 268
 269 subtest("Unstow a never stowed package", sub {
 270     plan tests => 2;
 271
 272     eval { remove_dir("$TEST_DIR/target"); };
 273     mkdir("$TEST_DIR/target");
 274
 275     my $stow = new_Stow();
 276     $stow->plan_unstow('pkg12');
 277     is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
 278     is(
 279         $stow->get_conflict_count,
 280         0
 281         => 'unstow never stowed package pkg12'
 282     );
 283 });
 284
 285 subtest("Unstowing when target contains a real file shouldn't be an issue", sub {
 286     plan tests => 3;
 287     make_file('man12/man1/file12.1');
 288
 289     my $stow = new_Stow();
 290     $stow->plan_unstow('pkg12');
 291     is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 for third time');
 292     my %conflicts = $stow->get_conflicts;
 293     is($stow->get_conflict_count, 1);
 294     like(
 295         $conflicts{unstow}{pkg12}[0],
 296         qr!existing target is neither a link nor a directory: man12/man1/file12\.1!
 297         => 'unstow pkg12 for third time'
 298     );
 299 });
 300
 301 subtest("unstow a simple tree minimally when cwd isn't target", sub {
 302     plan tests => 3;
 303     cd('../..');
 304     my $stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
 305
 306     make_path("$TEST_DIR/stow/pkg13/bin13");
 307     make_file("$TEST_DIR/stow/pkg13/bin13/file13");
 308     make_link("$TEST_DIR/target/bin13", '../stow/pkg13/bin13');
 309
 310     $stow->plan_unstow('pkg13');
 311     $stow->process_tasks();
 312     is($stow->get_conflict_count, 0);
 313     ok(-f "$TEST_DIR/stow/pkg13/bin13/file13");
 314     ok(! -e "$TEST_DIR/target/bin13" => 'unstow a simple tree');
 315 });
 316
 317 subtest("unstow a simple tree minimally with absolute stow dir when cwd isn't target", sub {
 318     plan tests => 3;
 319     my $stow = new_Stow(dir    => canon_path("$TEST_DIR/stow"),
 320                         target => "$TEST_DIR/target");
 321
 322     make_path("$TEST_DIR/stow/pkg14/bin14");
 323     make_file("$TEST_DIR/stow/pkg14/bin14/file14");
 324     make_link("$TEST_DIR/target/bin14", '../stow/pkg14/bin14');
 325
 326     $stow->plan_unstow('pkg14');
 327     $stow->process_tasks();
 328     is($stow->get_conflict_count, 0);
 329     ok(-f "$TEST_DIR/stow/pkg14/bin14/file14");
 330     ok(! -e "$TEST_DIR/target/bin14"
 331         => 'unstow a simple tree with absolute stow dir'
 332     );
 333 });
 334
 335 subtest("unstow a simple tree minimally with absolute stow AND target dirs when cwd isn't target", sub {
 336     plan tests => 3;
 337     my $stow = new_Stow(dir    => canon_path("$TEST_DIR/stow"),
 338                         target => canon_path("$TEST_DIR/target"));
 339
 340     make_path("$TEST_DIR/stow/pkg15/bin15");
 341     make_file("$TEST_DIR/stow/pkg15/bin15/file15");
 342     make_link("$TEST_DIR/target/bin15", '../stow/pkg15/bin15');
 343
 344     $stow->plan_unstow('pkg15');
 345     $stow->process_tasks();
 346     is($stow->get_conflict_count, 0);
 347     ok(-f "$TEST_DIR/stow/pkg15/bin15/file15");
 348     ok(! -e "$TEST_DIR/target/bin15"
 349         => 'unstow a simple tree with absolute stow and target dirs'
 350     );
 351 });
 352
 353 #
 354 # unstow a tree with no-folding enabled -
 355 # no refolding should take place
 356 #
 357 cd("$TEST_DIR/target");
 358
 359 sub create_and_stow_pkg {
 360     my ($id, $pkg) = @_;
 361
 362     my $stow_pkg = "../stow/$id-$pkg";
 363     make_path ($stow_pkg);
 364     make_file("$stow_pkg/$id-file-$pkg");
 365
 366     # create a shallow hierarchy specific to this package and stow
 367     # via folding
 368     make_path ("$stow_pkg/$id-$pkg-only-folded");
 369     make_file("$stow_pkg/$id-$pkg-only-folded/file-$pkg");
 370     make_link("$id-$pkg-only-folded", "$stow_pkg/$id-$pkg-only-folded");
 371
 372     # create a deeper hierarchy specific to this package and stow
 373     # via folding
 374     make_path ("$stow_pkg/$id-$pkg-only-folded2/subdir");
 375     make_file("$stow_pkg/$id-$pkg-only-folded2/subdir/file-$pkg");
 376     make_link("$id-$pkg-only-folded2",
 377               "$stow_pkg/$id-$pkg-only-folded2");
 378
 379     # create a shallow hierarchy specific to this package and stow
 380     # without folding
 381     make_path ("$stow_pkg/$id-$pkg-only-unfolded");
 382     make_file("$stow_pkg/$id-$pkg-only-unfolded/file-$pkg");
 383     make_path ("$id-$pkg-only-unfolded");
 384     make_link("$id-$pkg-only-unfolded/file-$pkg",
 385               "../$stow_pkg/$id-$pkg-only-unfolded/file-$pkg");
 386
 387     # create a deeper hierarchy specific to this package and stow
 388     # without folding
 389     make_path ("$stow_pkg/$id-$pkg-only-unfolded2/subdir");
 390     make_file("$stow_pkg/$id-$pkg-only-unfolded2/subdir/file-$pkg");
 391     make_path ("$id-$pkg-only-unfolded2/subdir");
 392     make_link("$id-$pkg-only-unfolded2/subdir/file-$pkg",
 393               "../../$stow_pkg/$id-$pkg-only-unfolded2/subdir/file-$pkg");
 394
 395     # create a shallow shared hierarchy which this package uses, and stow
 396     # its contents without folding
 397     make_path ("$stow_pkg/$id-shared");
 398     make_file("$stow_pkg/$id-shared/file-$pkg");
 399     make_path ("$id-shared");
 400     make_link("$id-shared/file-$pkg",
 401               "../$stow_pkg/$id-shared/file-$pkg");
 402
 403     # create a deeper shared hierarchy which this package uses, and stow
 404     # its contents without folding
 405     make_path ("$stow_pkg/$id-shared2/subdir");
 406     make_file("$stow_pkg/$id-shared2/file-$pkg");
 407     make_file("$stow_pkg/$id-shared2/subdir/file-$pkg");
 408     make_path ("$id-shared2/subdir");
 409     make_link("$id-shared2/file-$pkg",
 410               "../$stow_pkg/$id-shared2/file-$pkg");
 411     make_link("$id-shared2/subdir/file-$pkg",
 412               "../../$stow_pkg/$id-shared2/subdir/file-$pkg");
 413 }
 414
 415 foreach my $pkg (qw{a b}) {
 416     create_and_stow_pkg('no-folding', $pkg);
 417 }
 418
 419 my $stow = new_Stow('no-folding' => 1);
 420 $stow->plan_unstow('no-folding-b');
 421 is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
 422 use Data::Dumper;
 423 #warn Dumper($stow->get_tasks);
 424
 425 $stow->process_tasks();
 426
 427 is_nonexistent_path('no-folding-b-only-folded');
 428 is_nonexistent_path('no-folding-b-only-folded2');
 429 is_nonexistent_path('no-folding-b-only-unfolded/file-b');
 430 is_nonexistent_path('no-folding-b-only-unfolded2/subdir/file-b');
 431 is_dir_not_symlink('no-folding-shared');
 432 is_dir_not_symlink('no-folding-shared2');
 433 is_dir_not_symlink('no-folding-shared2/subdir');
 434
 435
 436 # Todo
 437 #
 438 # Test cleaning up subdirs with --paranoid option