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