3 # GNU Stow - manage the installation of multiple software packages
4 # Copyright (C) 1993, 1994, 1995, 1996 by Bob Glickstein
5 # Copyright (C) 2000,2001 Guillaume Morin
7 # This program is free software; you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 2 of the License, or
10 # (at your option) any later version.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 # $Id: stow.in,v 1.8 2002/01/05 11:27:01 gmorin Exp $
22 # $Source: /cvsroot/stow/stow/stow.in,v $
23 # $Date: 2002/01/05 11:27:01 $
26 # Add ".dontfold" support. A ".dontfold" file inside a package prevents its
27 # containing directory from being folded even if no other package contributes
28 # to that directory. Note that the ancestor directories up to the package root
29 # should have ".dontfold" files too or they might get folded. One must ensure
30 # that each directory in the target gets a ".dontfold" from at most one package,
31 # or stow will report conflicts.
34 # Add support for poststow scripts. - Matt 2009-10-20
41 $ProgramName =~ s,.*/,,;
56 # FIXME: use Getopt::Long
57 while (@ARGV && ($_ = $ARGV[0]) && /^-/) {
64 if ($opt =~ /^no?$/i) {
66 } elsif ($opt =~ /^c(o(n(f(l(i(c(ts?)?)?)?)?)?)?)?$/i) {
69 } elsif ($opt =~ /^dir?/i) {
71 if ($remainder =~ /^=/) {
72 $Stow = $'; # the stuff after the =
76 } elsif ($opt =~ /^t(a(r(g(et?)?)?)?)?/i) {
78 if ($remainder =~ /^=/) {
79 $Target = $'; # the stuff after the =
83 } elsif ($opt =~ /^verb(o(se?)?)?/i) {
85 if ($remainder =~ /^=(\d+)/) {
90 } elsif ($opt =~ /^de(l(e(te?)?)?)?$/i) {
92 } elsif ($opt =~ /^r(e(s(t(ow?)?)?)?)?$/i) {
94 } elsif ($opt =~ /^p(o(s(t(s(t(o(w(-(o(n(ly?)?)?)?)?)?)?)?)?)?)?)?$/i) {
96 } elsif ($opt =~ /^vers(i(on?)?)?$/i) {
99 &usage(($opt =~ /^h(e(lp?)?)?$/) ? undef :
100 "unknown or ambiguous option: $opt");
103 @opts = split(//, $opt);
104 while ($_ = shift(@opts)) {
107 } elsif ($_ eq 'c') {
110 } elsif ($_ eq 'd') {
111 $Stow = (join('', @opts) || shift);
113 } elsif ($_ eq 't') {
114 $Target = (join('', @opts) || shift);
116 } elsif ($_ eq 'v') {
118 } elsif ($_ eq 'D') {
120 } elsif ($_ eq 'R') {
122 } elsif ($_ eq 'V') {
125 &usage(($_ eq 'h') ? undef : "unknown option: $_");
132 &usage("--poststow-only should be used by itself") if @ARGV;
134 &usage("No packages named") unless @ARGV;
137 # Changing dirs helps a lot when soft links are used
138 $current_dir = &getcwd;
140 chdir($Stow) || die "Cannot chdir to target tree $Stow ($!)\n";
143 # This prevents problems if $Target was supplied as a relative path
146 chdir($current_dir) || die "Your directory does not seem to exist anymore ($!)\n";
149 if (basename($Stow) eq 'stow') {
150 $Target = &parent($Stow);
152 die "Not using the parent of the stow directory as the target because the basename of\n"
153 . "the stow directory is not \`stow'. This is a safety feature in case you\n"
154 . "mistakenly run this program in the target directory, to avoid trashing its\n"
155 . "parent. If you are sure you have the right stow directory, specify the target\n"
156 . "with the --target option to bypass this check.\n";
160 chdir($Target) || die "Cannot chdir to target tree $Target ($!)\n";
163 foreach $package (@ARGV) {
164 $package =~ s,/+$,,; # delete trailing slashes
165 if ($package =~ m,/,) {
166 die "$ProgramName: slashes not permitted in package names\n";
170 if (!$PoststowOnly && ($Delete || $Restow)) {
171 @Collections = @ARGV;
172 &Unstow('', &RelativePath($Target, $Stow));
175 if (!$PoststowOnly && (!$Delete || $Restow)) {
176 foreach $Collection (@ARGV) {
177 warn "Stowing package $Collection...\n" if $Verbose;
178 &StowContents($Collection, &RelativePath($Target, $Stow));
183 &RunPoststowScripts();
187 local($dir1, $dir2) = @_;
189 local(@d1) = split(/\/+/, $dir1);
190 local(@d2) = split(/\/+/, $dir2);
192 while (@d1 && @d2 && (($x = shift(@d1)) eq shift(@d2))) {
199 # Find the relative patch between
200 # two paths given as arguments.
204 local($c) = &CommonParent($a, $b);
205 local(@a) = split(/\/+/, $a);
206 local(@b) = split(/\/+/, $b);
207 local(@c) = split(/\/+/, $c);
209 # if $c == "/something", scalar(@c) >= 2
210 # but if $c == "/", scalar(@c) == 0
212 my $length = scalar(@c) ? scalar(@c) : 1;
213 splice(@a, 0, $length);
214 splice(@b, 0, $length);
216 unshift(@b, (('..') x (@a + 0)));
220 # Basically concatenates the paths given
224 local(@paths, @parts);
228 $result = '/' if ($_[0] =~ /^\//);
230 @parts = split(/\/+/, $x);
231 foreach $y (@parts) {
232 push(@paths, $y) if ($y ne "");
235 $result .= join('/', @paths);
239 local($targetdir, $stow) = @_;
242 local($linktarget, $stowmember, $collection);
244 local($pure, $othercollection) = (1, '');
245 local($subpure, $subother);
249 return (0, '') if (&JoinPaths($Target, $targetdir) eq $Stow);
250 return (0, '') if (-e &JoinPaths($Target, $targetdir, '.stow'));
251 warn sprintf("Unstowing in %s\n", &JoinPaths($Target, $targetdir))
253 if (!opendir(DIR, &JoinPaths($Target, $targetdir))) {
254 warn "Warning: $ProgramName: Cannot read directory \"$dir\" ($!). Stow might leave some links. If you think, it does. Rerun Stow with appropriate rights.\n";
256 @contents = readdir(DIR);
258 foreach $content (@contents) {
259 next if (($content eq '.') || ($content eq '..'));
261 if (-l &JoinPaths($Target, $targetdir, $content)) {
262 ($linktarget = readlink(&JoinPaths($Target,
265 || die sprintf("%s: Cannot read link %s (%s)\n",
267 &JoinPaths($Target, $targetdir, $content),
269 if ($stowmember = &FindStowMember(&JoinPaths($Target,
272 @stowmember = split(/\/+/, $stowmember);
273 $collection = shift(@stowmember);
274 if (grep(($collection eq $_), @Collections)) {
275 &DoUnlink(&JoinPaths($Target, $targetdir, $content));
277 if ($content eq '.dontfold') {
279 } elsif ($othercollection) {
280 $pure = 0 if ($collection ne $othercollection);
282 $othercollection = $collection;
288 } elsif (-d &JoinPaths($Target, $targetdir, $content)) {
289 ($subpure, $subother) = &Unstow(&JoinPaths($targetdir, $content),
290 &JoinPaths('..', $stow));
292 push(@puresubdirs, "$content/$subother");
296 if ($othercollection) {
298 if ($othercollection ne $subother) {
302 } elsif ($subother) {
303 $othercollection = $subother;
313 # This directory was an initially empty directory therefore
314 # We do not remove it.
316 if ((!$pure || !$targetdir) && @puresubdirs) {
317 &CoalesceTrees($targetdir, $stow, @puresubdirs);
319 ($pure, $othercollection);
323 local($parent, $stow, @trees) = @_;
324 local($tree, $collection, $x);
326 foreach $x (@trees) {
327 ($tree, $collection) = ($x =~ /^(.*)\/(.*)/);
328 &EmptyTree(&JoinPaths($Target, $parent, $tree));
329 &DoRmdir(&JoinPaths($Target, $parent, $tree));
331 &DoLink(&JoinPaths($stow, $collection, $parent, $tree),
332 &JoinPaths($Target, $parent, $tree));
343 || die "$ProgramName: Cannot read directory \"$dir\" ($!)\n";
344 @contents = readdir(DIR);
346 foreach $content (@contents) {
347 next if (($content eq '.') || ($content eq '..'));
348 if (-l &JoinPaths($dir, $content)) {
349 &DoUnlink(&JoinPaths($dir, $content));
350 } elsif (-d &JoinPaths($dir, $content)) {
351 &EmptyTree(&JoinPaths($dir, $content));
352 &DoRmdir(&JoinPaths($dir, $content));
354 &DoUnlink(&JoinPaths($dir, $content));
360 local($dir, $stow) = @_;
364 warn "Stowing contents of $dir\n" if ($Verbose > 1);
365 opendir(DIR, &JoinPaths($Stow, $dir))
366 || die "$ProgramName: Cannot read directory \"$dir\" ($!)\n";
367 @contents = readdir(DIR);
369 foreach $content (@contents) {
370 next if (($content eq '.') || ($content eq '..'));
371 if (-d &JoinPaths($Stow, $dir, $content)) {
372 &StowDir(&JoinPaths($dir, $content), $stow);
374 &StowNondir(&JoinPaths($dir, $content), $stow);
380 local($dir, $stow) = @_;
381 local(@dir) = split(/\/+/, $dir);
382 local($collection) = shift(@dir);
383 local($subdir) = join('/', @dir);
384 local($linktarget, $stowsubdir);
386 warn "Stowing directory $dir\n" if ($Verbose > 1);
387 if (-l &JoinPaths($Target, $subdir)) {
388 ($linktarget = readlink(&JoinPaths($Target, $subdir)))
389 || die sprintf("%s: Could not read link %s (%s)\n",
391 &JoinPaths($Target, $subdir),
394 &FindStowMember(sprintf('%s/%s', $Target,
395 join('/', @dir[0..($#dir - 1)])),
397 || (&Conflict($dir, $subdir), return);
398 if (-e &JoinPaths($Stow, $stowsubdir)) {
399 if ($stowsubdir eq $dir) {
400 warn sprintf("%s already points to %s\n",
401 &JoinPaths($Target, $subdir),
402 &JoinPaths($Stow, $dir))
406 if (-d &JoinPaths($Stow, $stowsubdir)) {
407 &DoUnlink(&JoinPaths($Target, $subdir));
408 &DoMkdir(&JoinPaths($Target, $subdir));
409 &StowContents($stowsubdir, &JoinPaths('..', $stow));
410 &StowContents($dir, &JoinPaths('..', $stow));
412 (&Conflict($dir, $subdir), return);
415 &DoUnlink(&JoinPaths($Target, $subdir));
416 &StowNewDir($dir, $stow);
418 } elsif (-e &JoinPaths($Target, $subdir)) {
419 if (-d &JoinPaths($Target, $subdir)) {
420 &StowContents($dir, &JoinPaths('..', $stow));
422 &Conflict($dir, $subdir);
425 &StowNewDir($dir, $stow);
430 local($dir, $stow) = @_;
431 if (-e &JoinPaths($Stow, $dir, '.dontfold')) {
432 &DoMkdir(&JoinPaths($Target, $subdir));
433 &StowContents($dir, &JoinPaths('..', $stow));
435 &DoLink(&JoinPaths($stow, $dir),
436 &JoinPaths($Target, $subdir));
441 local($file, $stow) = @_;
442 local(@file) = split(/\/+/, $file);
443 local($collection) = shift(@file);
444 local($subfile) = join('/', @file);
445 local($linktarget, $stowsubfile);
447 if (-l &JoinPaths($Target, $subfile)) {
448 ($linktarget = readlink(&JoinPaths($Target, $subfile)))
449 || die sprintf("%s: Could not read link %s (%s)\n",
451 &JoinPaths($Target, $subfile),
454 &FindStowMember(sprintf('%s/%s', $Target,
455 join('/', @file[0..($#file - 1)])),
457 || (&Conflict($file, $subfile), return);
458 if (-e &JoinPaths($Stow, $stowsubfile)) {
459 (&Conflict($file, $subfile), return)
460 unless ($stowsubfile eq $file);
461 warn sprintf("%s already points to %s\n",
462 &JoinPaths($Target, $subfile),
463 &JoinPaths($Stow, $file))
466 &DoUnlink(&JoinPaths($Target, $subfile));
467 &DoLink(&JoinPaths($stow, $file),
468 &JoinPaths($Target, $subfile));
470 } elsif (-e &JoinPaths($Target, $subfile)) {
471 &Conflict($file, $subfile);
473 &DoLink(&JoinPaths($stow, $file),
474 &JoinPaths($Target, $subfile));
481 warn "UNLINK $file\n" if $Verbose;
482 (unlink($file) || die "$ProgramName: Could not unlink $file ($!)\n")
489 warn "RMDIR $dir\n" if $Verbose;
490 (rmdir($dir) || die "$ProgramName: Could not rmdir $dir ($!)\n")
495 local($target, $name) = @_;
497 warn "LINK $name to $target\n" if $Verbose;
498 (symlink($target, $name) ||
499 die "$ProgramName: Could not symlink $name to $target ($!)\n")
506 warn "MKDIR $dir\n" if $Verbose;
508 || die "$ProgramName: Could not make directory $dir ($!)\n")
516 warn sprintf("CONFLICT: %s vs. %s\n", &JoinPaths($Stow, $a),
517 &JoinPaths($Target, $b));
519 die sprintf("%s: CONFLICT: %s vs. %s\n",
521 &JoinPaths($Stow, $a),
522 &JoinPaths($Target, $b));
527 local($start, $path) = @_;
528 local(@x) = split(/\/+/, $start);
529 local(@path) = split(/\/+/, $path);
531 local(@d) = split(/\/+/, $Stow);
543 if (($x = shift(@x)) ne shift(@d)) {
551 sub RunPoststowScripts {
554 local($psd) = &JoinPaths($Target, 'poststow.d');
556 if (opendir(PSD, $psd)) {
558 } elsif ($! eq 'No such file or directory') {
559 # it doesn't exist, skip this step
560 warn "Poststow script directory does not exist\n" if $Verbose;
563 die "$ProgramName: Cannot read poststow script directory ($!)\n";
565 warn "Running poststow scripts...\n" if $Verbose;
566 @scripts = readdir(PSD); # XXX Should we define the order?
568 foreach $script (@scripts) {
569 next if ($script =~ m/^\./); # catches '.', '..', '.dontfold', and maybe others
570 warn "Running poststow script '$script'...\n" if $Verbose;
571 system(&JoinPaths($psd, $script), $Target) == 0 or
572 warn "Poststow script '$script' failed\n";
577 local($path) = join('/', @_);
578 local(@elts) = split(/\/+/, $path);
587 print "$ProgramName: $msg\n";
589 print "$ProgramName (GNU Stow) version $Version\n\n";
590 print "Usage: $ProgramName [OPTION ...] PACKAGE ...\n";
592 -n, --no Do not actually make changes
593 -c, --conflicts Scan for conflicts, implies -n
594 -d DIR, --dir=DIR Set stow dir to DIR (default is current dir)
595 -t DIR, --target=DIR Set target to DIR (default is parent of stow dir)
596 -v, --verbose[=N] Increase verboseness (levels are 0,1,2,3;
597 -v or --verbose adds 1; --verbose=N sets level)
598 -D, --delete Unstow instead of stow
599 -R, --restow Restow (like stow -D followed by stow)
600 --poststow-only Run poststow scripts without (un)stowing any packages
601 -V, --version Show Stow version number
602 -h, --help Show this help
608 print "$ProgramName (GNU Stow) version $Version\n";