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