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