| 1 | #!/usr/bin/perl |
| 2 | |
| 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 |
| 6 | # |
| 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. |
| 11 | # |
| 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. |
| 16 | # |
| 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. |
| 20 | # |
| 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 $ |
| 24 | # $Author: gmorin $ |
| 25 | |
| 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. |
| 32 | # - Matt 2009-10-19 |
| 33 | |
| 34 | # Add support for poststow scripts. - Matt 2009-10-20 |
| 35 | |
| 36 | require 5.005; |
| 37 | use POSIX; |
| 38 | use File::Basename; |
| 39 | |
| 40 | $ProgramName = $0; |
| 41 | $ProgramName =~ s,.*/,,; |
| 42 | |
| 43 | $Version = '1.3.3'; |
| 44 | |
| 45 | $Conflicts = 0; |
| 46 | $Delete = 0; |
| 47 | $NotReally = 0; |
| 48 | $Verbose = 0; |
| 49 | $ReportHelp = 0; |
| 50 | $Stow = undef; |
| 51 | $Target = undef; |
| 52 | $Restow = 0; |
| 53 | $PoststowOnly = 0; |
| 54 | |
| 55 | |
| 56 | # FIXME: use Getopt::Long |
| 57 | while (@ARGV && ($_ = $ARGV[0]) && /^-/) { |
| 58 | $opt = $'; |
| 59 | shift; |
| 60 | last if /^--$/; |
| 61 | |
| 62 | if ($opt =~ /^-/) { |
| 63 | $opt = $'; |
| 64 | if ($opt =~ /^no?$/i) { |
| 65 | $NotReally = 1; |
| 66 | } elsif ($opt =~ /^c(o(n(f(l(i(c(ts?)?)?)?)?)?)?)?$/i) { |
| 67 | $Conflicts = 1; |
| 68 | $NotReally = 1; |
| 69 | } elsif ($opt =~ /^dir?/i) { |
| 70 | $remainder = $'; |
| 71 | if ($remainder =~ /^=/) { |
| 72 | $Stow = $'; # the stuff after the = |
| 73 | } else { |
| 74 | $Stow = shift; |
| 75 | } |
| 76 | } elsif ($opt =~ /^t(a(r(g(et?)?)?)?)?/i) { |
| 77 | $remainder = $'; |
| 78 | if ($remainder =~ /^=/) { |
| 79 | $Target = $'; # the stuff after the = |
| 80 | } else { |
| 81 | $Target = shift; |
| 82 | } |
| 83 | } elsif ($opt =~ /^verb(o(se?)?)?/i) { |
| 84 | $remainder = $'; |
| 85 | if ($remainder =~ /^=(\d+)/) { |
| 86 | $Verbose = $1; |
| 87 | } else { |
| 88 | ++$Verbose; |
| 89 | } |
| 90 | } elsif ($opt =~ /^de(l(e(te?)?)?)?$/i) { |
| 91 | $Delete = 1; |
| 92 | } elsif ($opt =~ /^r(e(s(t(ow?)?)?)?)?$/i) { |
| 93 | $Restow = 1; |
| 94 | } elsif ($opt =~ /^p(o(s(t(s(t(o(w(-(o(n(ly?)?)?)?)?)?)?)?)?)?)?)?$/i) { |
| 95 | $PoststowOnly = 1; |
| 96 | } elsif ($opt =~ /^vers(i(on?)?)?$/i) { |
| 97 | &version(); |
| 98 | } else { |
| 99 | &usage(($opt =~ /^h(e(lp?)?)?$/) ? undef : |
| 100 | "unknown or ambiguous option: $opt"); |
| 101 | } |
| 102 | } else { |
| 103 | @opts = split(//, $opt); |
| 104 | while ($_ = shift(@opts)) { |
| 105 | if ($_ eq 'n') { |
| 106 | $NotReally = 1; |
| 107 | } elsif ($_ eq 'c') { |
| 108 | $Conflicts = 1; |
| 109 | $NotReally = 1; |
| 110 | } elsif ($_ eq 'd') { |
| 111 | $Stow = (join('', @opts) || shift); |
| 112 | @opts = (); |
| 113 | } elsif ($_ eq 't') { |
| 114 | $Target = (join('', @opts) || shift); |
| 115 | @opts = (); |
| 116 | } elsif ($_ eq 'v') { |
| 117 | ++$Verbose; |
| 118 | } elsif ($_ eq 'D') { |
| 119 | $Delete = 1; |
| 120 | } elsif ($_ eq 'R') { |
| 121 | $Restow = 1; |
| 122 | } elsif ($_ eq 'V') { |
| 123 | &version(); |
| 124 | } else { |
| 125 | &usage(($_ eq 'h') ? undef : "unknown option: $_"); |
| 126 | } |
| 127 | } |
| 128 | } |
| 129 | } |
| 130 | |
| 131 | if ($PoststowOnly) { |
| 132 | &usage("--poststow-only should be used by itself") if @ARGV; |
| 133 | } else { |
| 134 | &usage("No packages named") unless @ARGV; |
| 135 | } |
| 136 | |
| 137 | # Changing dirs helps a lot when soft links are used |
| 138 | $current_dir = &getcwd; |
| 139 | if ($Stow) { |
| 140 | chdir($Stow) || die "Cannot chdir to target tree $Stow ($!)\n"; |
| 141 | } |
| 142 | |
| 143 | # This prevents problems if $Target was supplied as a relative path |
| 144 | $Stow = &getcwd; |
| 145 | |
| 146 | chdir($current_dir) || die "Your directory does not seem to exist anymore ($!)\n"; |
| 147 | |
| 148 | unless ($Target) { |
| 149 | if (basename($Stow) eq 'stow') { |
| 150 | $Target = &parent($Stow); |
| 151 | } else { |
| 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"; |
| 157 | } |
| 158 | } |
| 159 | |
| 160 | chdir($Target) || die "Cannot chdir to target tree $Target ($!)\n"; |
| 161 | $Target = &getcwd; |
| 162 | |
| 163 | foreach $package (@ARGV) { |
| 164 | $package =~ s,/+$,,; # delete trailing slashes |
| 165 | if ($package =~ m,/,) { |
| 166 | die "$ProgramName: slashes not permitted in package names\n"; |
| 167 | } |
| 168 | } |
| 169 | |
| 170 | if (!$PoststowOnly && ($Delete || $Restow)) { |
| 171 | @Collections = @ARGV; |
| 172 | &Unstow('', &RelativePath($Target, $Stow)); |
| 173 | } |
| 174 | |
| 175 | if (!$PoststowOnly && (!$Delete || $Restow)) { |
| 176 | foreach $Collection (@ARGV) { |
| 177 | warn "Stowing package $Collection...\n" if $Verbose; |
| 178 | &StowContents($Collection, &RelativePath($Target, $Stow)); |
| 179 | } |
| 180 | } |
| 181 | |
| 182 | if (!$NotReally) { |
| 183 | &RunPoststowScripts(); |
| 184 | } |
| 185 | |
| 186 | sub CommonParent { |
| 187 | local($dir1, $dir2) = @_; |
| 188 | local($result, $x); |
| 189 | local(@d1) = split(/\/+/, $dir1); |
| 190 | local(@d2) = split(/\/+/, $dir2); |
| 191 | |
| 192 | while (@d1 && @d2 && (($x = shift(@d1)) eq shift(@d2))) { |
| 193 | $result .= "$x/"; |
| 194 | } |
| 195 | chop($result); |
| 196 | $result; |
| 197 | } |
| 198 | |
| 199 | # Find the relative patch between |
| 200 | # two paths given as arguments. |
| 201 | |
| 202 | sub RelativePath { |
| 203 | local($a, $b) = @_; |
| 204 | local($c) = &CommonParent($a, $b); |
| 205 | local(@a) = split(/\/+/, $a); |
| 206 | local(@b) = split(/\/+/, $b); |
| 207 | local(@c) = split(/\/+/, $c); |
| 208 | |
| 209 | # if $c == "/something", scalar(@c) >= 2 |
| 210 | # but if $c == "/", scalar(@c) == 0 |
| 211 | # but we want 1 |
| 212 | my $length = scalar(@c) ? scalar(@c) : 1; |
| 213 | splice(@a, 0, $length); |
| 214 | splice(@b, 0, $length); |
| 215 | |
| 216 | unshift(@b, (('..') x (@a + 0))); |
| 217 | &JoinPaths(@b); |
| 218 | } |
| 219 | |
| 220 | # Basically concatenates the paths given |
| 221 | # as arguments |
| 222 | |
| 223 | sub JoinPaths { |
| 224 | local(@paths, @parts); |
| 225 | local ($x, $y); |
| 226 | local($result) = ''; |
| 227 | |
| 228 | $result = '/' if ($_[0] =~ /^\//); |
| 229 | foreach $x (@_) { |
| 230 | @parts = split(/\/+/, $x); |
| 231 | foreach $y (@parts) { |
| 232 | push(@paths, $y) if ($y ne ""); |
| 233 | } |
| 234 | } |
| 235 | $result .= join('/', @paths); |
| 236 | } |
| 237 | |
| 238 | sub Unstow { |
| 239 | local($targetdir, $stow) = @_; |
| 240 | local(@contents); |
| 241 | local($content); |
| 242 | local($linktarget, $stowmember, $collection); |
| 243 | local(@stowmember); |
| 244 | local($pure, $othercollection) = (1, ''); |
| 245 | local($subpure, $subother); |
| 246 | local($empty) = (1); |
| 247 | local(@puresubdirs); |
| 248 | |
| 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)) |
| 252 | if ($Verbose > 1); |
| 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"; |
| 255 | } |
| 256 | @contents = readdir(DIR); |
| 257 | closedir(DIR); |
| 258 | foreach $content (@contents) { |
| 259 | next if (($content eq '.') || ($content eq '..')); |
| 260 | $empty = 0; |
| 261 | if (-l &JoinPaths($Target, $targetdir, $content)) { |
| 262 | ($linktarget = readlink(&JoinPaths($Target, |
| 263 | $targetdir, |
| 264 | $content))) |
| 265 | || die sprintf("%s: Cannot read link %s (%s)\n", |
| 266 | $ProgramName, |
| 267 | &JoinPaths($Target, $targetdir, $content), |
| 268 | $!); |
| 269 | if ($stowmember = &FindStowMember(&JoinPaths($Target, |
| 270 | $targetdir), |
| 271 | $linktarget)) { |
| 272 | @stowmember = split(/\/+/, $stowmember); |
| 273 | $collection = shift(@stowmember); |
| 274 | if (grep(($collection eq $_), @Collections)) { |
| 275 | &DoUnlink(&JoinPaths($Target, $targetdir, $content)); |
| 276 | } elsif ($pure) { |
| 277 | if ($content eq '.dontfold') { |
| 278 | $pure = 0; |
| 279 | } elsif ($othercollection) { |
| 280 | $pure = 0 if ($collection ne $othercollection); |
| 281 | } else { |
| 282 | $othercollection = $collection; |
| 283 | } |
| 284 | } |
| 285 | } else { |
| 286 | $pure = 0; |
| 287 | } |
| 288 | } elsif (-d &JoinPaths($Target, $targetdir, $content)) { |
| 289 | ($subpure, $subother) = &Unstow(&JoinPaths($targetdir, $content), |
| 290 | &JoinPaths('..', $stow)); |
| 291 | if ($subpure) { |
| 292 | push(@puresubdirs, "$content/$subother"); |
| 293 | } |
| 294 | if ($pure) { |
| 295 | if ($subpure) { |
| 296 | if ($othercollection) { |
| 297 | if ($subother) { |
| 298 | if ($othercollection ne $subother) { |
| 299 | $pure = 0; |
| 300 | } |
| 301 | } |
| 302 | } elsif ($subother) { |
| 303 | $othercollection = $subother; |
| 304 | } |
| 305 | } else { |
| 306 | $pure = 0; |
| 307 | } |
| 308 | } |
| 309 | } else { |
| 310 | $pure = 0; |
| 311 | } |
| 312 | } |
| 313 | # This directory was an initially empty directory therefore |
| 314 | # We do not remove it. |
| 315 | $pure = 0 if $empty; |
| 316 | if ((!$pure || !$targetdir) && @puresubdirs) { |
| 317 | &CoalesceTrees($targetdir, $stow, @puresubdirs); |
| 318 | } |
| 319 | ($pure, $othercollection); |
| 320 | } |
| 321 | |
| 322 | sub CoalesceTrees { |
| 323 | local($parent, $stow, @trees) = @_; |
| 324 | local($tree, $collection, $x); |
| 325 | |
| 326 | foreach $x (@trees) { |
| 327 | ($tree, $collection) = ($x =~ /^(.*)\/(.*)/); |
| 328 | &EmptyTree(&JoinPaths($Target, $parent, $tree)); |
| 329 | &DoRmdir(&JoinPaths($Target, $parent, $tree)); |
| 330 | if ($collection) { |
| 331 | &DoLink(&JoinPaths($stow, $collection, $parent, $tree), |
| 332 | &JoinPaths($Target, $parent, $tree)); |
| 333 | } |
| 334 | } |
| 335 | } |
| 336 | |
| 337 | sub EmptyTree { |
| 338 | local($dir) = @_; |
| 339 | local(@contents); |
| 340 | local($content); |
| 341 | |
| 342 | opendir(DIR, $dir) |
| 343 | || die "$ProgramName: Cannot read directory \"$dir\" ($!)\n"; |
| 344 | @contents = readdir(DIR); |
| 345 | closedir(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)); |
| 353 | } else { |
| 354 | &DoUnlink(&JoinPaths($dir, $content)); |
| 355 | } |
| 356 | } |
| 357 | } |
| 358 | |
| 359 | sub StowContents { |
| 360 | local($dir, $stow) = @_; |
| 361 | local(@contents); |
| 362 | local($content); |
| 363 | |
| 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); |
| 368 | closedir(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); |
| 373 | } else { |
| 374 | &StowNondir(&JoinPaths($dir, $content), $stow); |
| 375 | } |
| 376 | } |
| 377 | } |
| 378 | |
| 379 | sub StowDir { |
| 380 | local($dir, $stow) = @_; |
| 381 | local(@dir) = split(/\/+/, $dir); |
| 382 | local($collection) = shift(@dir); |
| 383 | local($subdir) = join('/', @dir); |
| 384 | local($linktarget, $stowsubdir); |
| 385 | |
| 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", |
| 390 | $ProgramName, |
| 391 | &JoinPaths($Target, $subdir), |
| 392 | $!); |
| 393 | ($stowsubdir = |
| 394 | &FindStowMember(sprintf('%s/%s', $Target, |
| 395 | join('/', @dir[0..($#dir - 1)])), |
| 396 | $linktarget)) |
| 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)) |
| 403 | if ($Verbose > 2); |
| 404 | return; |
| 405 | } |
| 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)); |
| 411 | } else { |
| 412 | (&Conflict($dir, $subdir), return); |
| 413 | } |
| 414 | } else { |
| 415 | &DoUnlink(&JoinPaths($Target, $subdir)); |
| 416 | &StowNewDir($dir, $stow); |
| 417 | } |
| 418 | } elsif (-e &JoinPaths($Target, $subdir)) { |
| 419 | if (-d &JoinPaths($Target, $subdir)) { |
| 420 | &StowContents($dir, &JoinPaths('..', $stow)); |
| 421 | } else { |
| 422 | &Conflict($dir, $subdir); |
| 423 | } |
| 424 | } else { |
| 425 | &StowNewDir($dir, $stow); |
| 426 | } |
| 427 | } |
| 428 | |
| 429 | sub StowNewDir { |
| 430 | local($dir, $stow) = @_; |
| 431 | if (-e &JoinPaths($Stow, $dir, '.dontfold')) { |
| 432 | &DoMkdir(&JoinPaths($Target, $subdir)); |
| 433 | &StowContents($dir, &JoinPaths('..', $stow)); |
| 434 | } else { |
| 435 | &DoLink(&JoinPaths($stow, $dir), |
| 436 | &JoinPaths($Target, $subdir)); |
| 437 | } |
| 438 | } |
| 439 | |
| 440 | sub StowNondir { |
| 441 | local($file, $stow) = @_; |
| 442 | local(@file) = split(/\/+/, $file); |
| 443 | local($collection) = shift(@file); |
| 444 | local($subfile) = join('/', @file); |
| 445 | local($linktarget, $stowsubfile); |
| 446 | |
| 447 | if (-l &JoinPaths($Target, $subfile)) { |
| 448 | ($linktarget = readlink(&JoinPaths($Target, $subfile))) |
| 449 | || die sprintf("%s: Could not read link %s (%s)\n", |
| 450 | $ProgramName, |
| 451 | &JoinPaths($Target, $subfile), |
| 452 | $!); |
| 453 | ($stowsubfile = |
| 454 | &FindStowMember(sprintf('%s/%s', $Target, |
| 455 | join('/', @file[0..($#file - 1)])), |
| 456 | $linktarget)) |
| 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)) |
| 464 | if ($Verbose > 2); |
| 465 | } else { |
| 466 | &DoUnlink(&JoinPaths($Target, $subfile)); |
| 467 | &DoLink(&JoinPaths($stow, $file), |
| 468 | &JoinPaths($Target, $subfile)); |
| 469 | } |
| 470 | } elsif (-e &JoinPaths($Target, $subfile)) { |
| 471 | &Conflict($file, $subfile); |
| 472 | } else { |
| 473 | &DoLink(&JoinPaths($stow, $file), |
| 474 | &JoinPaths($Target, $subfile)); |
| 475 | } |
| 476 | } |
| 477 | |
| 478 | sub DoUnlink { |
| 479 | local($file) = @_; |
| 480 | |
| 481 | warn "UNLINK $file\n" if $Verbose; |
| 482 | (unlink($file) || die "$ProgramName: Could not unlink $file ($!)\n") |
| 483 | unless $NotReally; |
| 484 | } |
| 485 | |
| 486 | sub DoRmdir { |
| 487 | local($dir) = @_; |
| 488 | |
| 489 | warn "RMDIR $dir\n" if $Verbose; |
| 490 | (rmdir($dir) || die "$ProgramName: Could not rmdir $dir ($!)\n") |
| 491 | unless $NotReally; |
| 492 | } |
| 493 | |
| 494 | sub DoLink { |
| 495 | local($target, $name) = @_; |
| 496 | |
| 497 | warn "LINK $name to $target\n" if $Verbose; |
| 498 | (symlink($target, $name) || |
| 499 | die "$ProgramName: Could not symlink $name to $target ($!)\n") |
| 500 | unless $NotReally; |
| 501 | } |
| 502 | |
| 503 | sub DoMkdir { |
| 504 | local($dir) = @_; |
| 505 | |
| 506 | warn "MKDIR $dir\n" if $Verbose; |
| 507 | (mkdir($dir, 0777) |
| 508 | || die "$ProgramName: Could not make directory $dir ($!)\n") |
| 509 | unless $NotReally; |
| 510 | } |
| 511 | |
| 512 | sub Conflict { |
| 513 | local($a, $b) = @_; |
| 514 | |
| 515 | if ($Conflicts) { |
| 516 | warn sprintf("CONFLICT: %s vs. %s\n", &JoinPaths($Stow, $a), |
| 517 | &JoinPaths($Target, $b)); |
| 518 | } else { |
| 519 | die sprintf("%s: CONFLICT: %s vs. %s\n", |
| 520 | $ProgramName, |
| 521 | &JoinPaths($Stow, $a), |
| 522 | &JoinPaths($Target, $b)); |
| 523 | } |
| 524 | } |
| 525 | |
| 526 | sub FindStowMember { |
| 527 | local($start, $path) = @_; |
| 528 | local(@x) = split(/\/+/, $start); |
| 529 | local(@path) = split(/\/+/, $path); |
| 530 | local($x); |
| 531 | local(@d) = split(/\/+/, $Stow); |
| 532 | |
| 533 | while (@path) { |
| 534 | $x = shift(@path); |
| 535 | if ($x eq '..') { |
| 536 | pop(@x); |
| 537 | return '' unless @x; |
| 538 | } elsif ($x) { |
| 539 | push(@x, $x); |
| 540 | } |
| 541 | } |
| 542 | while (@x && @d) { |
| 543 | if (($x = shift(@x)) ne shift(@d)) { |
| 544 | return ''; |
| 545 | } |
| 546 | } |
| 547 | return '' if @d; |
| 548 | join('/', @x); |
| 549 | } |
| 550 | |
| 551 | sub RunPoststowScripts { |
| 552 | local(@scripts); |
| 553 | local($script); |
| 554 | local($psd) = &JoinPaths($Target, 'poststow.d'); |
| 555 | |
| 556 | if (opendir(PSD, $psd)) { |
| 557 | # good |
| 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; |
| 561 | return; |
| 562 | } else { |
| 563 | die "$ProgramName: Cannot read poststow script directory ($!)\n"; |
| 564 | } |
| 565 | warn "Running poststow scripts...\n" if $Verbose; |
| 566 | @scripts = readdir(PSD); # XXX Should we define the order? |
| 567 | closedir(PSD); |
| 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"; |
| 573 | } |
| 574 | } |
| 575 | |
| 576 | sub parent { |
| 577 | local($path) = join('/', @_); |
| 578 | local(@elts) = split(/\/+/, $path); |
| 579 | pop(@elts); |
| 580 | join('/', @elts); |
| 581 | } |
| 582 | |
| 583 | sub usage { |
| 584 | local($msg) = shift; |
| 585 | |
| 586 | if ($msg) { |
| 587 | print "$ProgramName: $msg\n"; |
| 588 | } |
| 589 | print "$ProgramName (GNU Stow) version $Version\n\n"; |
| 590 | print "Usage: $ProgramName [OPTION ...] PACKAGE ...\n"; |
| 591 | print <<EOT; |
| 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 |
| 603 | EOT |
| 604 | exit($msg ? 1 : 0); |
| 605 | } |
| 606 | |
| 607 | sub version { |
| 608 | print "$ProgramName (GNU Stow) version $Version\n"; |
| 609 | exit(0); |
| 610 | } |
| 611 | |
| 612 | # Local variables: |
| 613 | # mode: perl |
| 614 | # End: |