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