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