t/unstow.t

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