bin/stow.in

   1 #!@PERL@
   2
   3 # GNU Stow - manage farms of symbolic links
   4 # Copyright (C) 1993, 1994, 1995, 1996 by Bob Glickstein
   5 # Copyright (C) 2000, 2001 Guillaume Morin
   6 # Copyright (C) 2007 Kahlil Hodgson
   7 # Copyright (C) 2011 Adam Spiers
   8 #
   9 # This file is part of GNU Stow.
  10 #
  11 # GNU Stow is free software: you can redistribute it and/or modify it
  12 # under the terms of the GNU General Public License as published by
  13 # the Free Software Foundation, either version 3 of the License, or
  14 # (at your option) any later version.
  15 #
  16 # GNU Stow is distributed in the hope that it will be useful, but
  17 # WITHOUT ANY WARRANTY; without even the implied warranty of
  18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  19 # General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License
  22 # along with this program. If not, see https://www.gnu.org/licenses/.
  23
  24 =head1 NAME
  25
  26 stow - manage farms of symbolic links
  27
  28 =head1 SYNOPSIS
  29
  30 stow [ options ] package ...
  31
  32 =head1 DESCRIPTION
  33
  34 This manual page describes GNU Stow @VERSION@.  This is not the
  35 definitive documentation for Stow; for that, see the accompanying info
  36 manual, e.g. by typing C<info stow>.
  37
  38 Stow is a symlink farm manager which takes distinct sets of software
  39 and/or data located in separate directories on the filesystem, and
  40 makes them all appear to be installed in a single directory tree.
  41
  42 Originally Stow was born to address the need to administer, upgrade,
  43 install, and remove files in independent software packages without
  44 confusing them with other files sharing the same file system space.
  45 For instance, many years ago it used to be common to compile programs
  46 such as Perl and Emacs from source.  By using Stow, F</usr/local/bin>
  47 could contain symlinks to files within F</usr/local/stow/emacs/bin>,
  48 F</usr/local/stow/perl/bin> etc., and likewise recursively for any
  49 other subdirectories such as F<.../share>, F<.../man>, and so on.
  50
  51 While this is useful for keeping track of system-wide and per-user
  52 installations of software built from source, in more recent times
  53 software packages are often managed by more sophisticated package
  54 management software such as rpm, dpkg, and Nix / GNU Guix, or
  55 language-native package managers such as Ruby's gem, Python's pip,
  56 Javascript's npm, and so on.
  57
  58 However Stow is still used not only for software package management,
  59 but also for other purposes, such as facilitating a more controlled
  60 approach to management of configuration files in the user's home
  61 directory, especially when coupled with version control systems.
  62
  63 Stow was inspired by Carnegie Mellon's Depot program, but is
  64 substantially simpler and safer. Whereas Depot required database files
  65 to keep things in sync, Stow stores no extra state between runs, so
  66 there's no danger (as there was in Depot) of mangling directories when
  67 file hierarchies don't match the database. Also unlike Depot, Stow
  68 will never delete any files, directories, or links that appear in a
  69 Stow directory (e.g., F</usr/local/stow/emacs>), so it's always
  70 possible to rebuild the target tree (e.g., F</usr/local>).
  71
  72 Stow is implemented as a combination of a Perl script providing a CLI
  73 interface, and a backend Perl module which does most of the work.
  74
  75 =head1 TERMINOLOGY
  76
  77 A "package" is a related collection of files and directories that
  78 you wish to administer as a unit -- e.g., Perl or Emacs -- and that
  79 needs to be installed in a particular directory structure -- e.g.,
  80 with F<bin>, F<lib>, and F<man> subdirectories.
  81
  82 A "target directory" is the root of a tree in which one or more
  83 packages wish to B<appear> to be installed. A common, but by no means
  84 the only such location is F</usr/local>.  The examples in this manual
  85 page will use F</usr/local> as the target directory.
  86
  87 A "stow directory" is the root of a tree containing separate
  88 packages in private subtrees. When Stow runs, it uses the current
  89 directory as the default stow directory. The examples in this manual
  90 page will use F</usr/local/stow> as the stow directory, so that
  91 individual packages will be, for example, F</usr/local/stow/perl> and
  92 F</usr/local/stow/emacs>.
  93
  94 An "installation image" is the layout of files and directories
  95 required by a package, relative to the target directory. Thus, the
  96 installation image for Perl includes: a F<bin> directory containing
  97 F<perl> and F<a2p> (among others); an F<info> directory containing
  98 Texinfo documentation; a F<lib/perl> directory containing Perl
  99 libraries; and a F<man/man1> directory containing man pages.
 100
 101 A "package directory" is the root of a tree containing the
 102 installation image for a particular package. Each package directory
 103 must reside in a stow directory -- e.g., the package directory
 104 F</usr/local/stow/perl> must reside in the stow directory
 105 F</usr/local/stow>.  The "name" of a package is the name of its
 106 directory within the stow directory -- e.g., F<perl>.
 107
 108 Thus, the Perl executable might reside in
 109 F</usr/local/stow/perl/bin/perl>, where F</usr/local> is the target
 110 directory, F</usr/local/stow> is the stow directory,
 111 F</usr/local/stow/perl> is the package directory, and F<bin/perl>
 112 within is part of the installation image.
 113
 114 A "symlink" is a symbolic link. A symlink can be "relative" or
 115 "absolute". An absolute symlink names a full path; that is, one
 116 starting from F</>.  A relative symlink names a relative path; that
 117 is, one not starting from F</>.  The target of a relative symlink is
 118 computed starting from the symlink's own directory.  Stow only creates
 119 relative symlinks.
 120
 121 =head1 OPTIONS
 122
 123 The stow directory is assumed to be the value of the C<STOW_DIR>
 124 environment variable or if unset the current directory, and the target
 125 directory is assumed to be the parent of the current directory (so it
 126 is typical to execute F<stow> from the directory F</usr/local/stow>).
 127 Each F<package> given on the command line is the name of a package in
 128 the stow directory (e.g., F<perl>).  By default, they are installed
 129 into the target directory (but they can be deleted instead using
 130 C<-D>).
 131
 132 =over 4
 133
 134 =item -n
 135
 136 =item --no
 137
 138 =item --simulate
 139
 140 Do not perform any operations that modify the filesystem; merely show
 141 what would happen.
 142
 143 =item -d DIR
 144
 145 =item --dir=DIR
 146
 147 Set the stow directory to C<DIR> instead of the current directory.
 148 This also has the effect of making the default target directory be the
 149 parent of C<DIR>.
 150
 151 =item -t DIR
 152
 153 =item --target=DIR
 154
 155 Set the target directory to C<DIR> instead of the parent of the stow
 156 directory.
 157
 158 =item -v
 159
 160 =item --verbose[=N]
 161
 162 Send verbose output to standard error describing what Stow is
 163 doing. Verbosity levels are from 0 to 5; 0 is the default.
 164 Using C<-v> or C<--verbose> increases the verbosity by one; using
 165 `--verbose=N' sets it to N.
 166
 167 =item -S
 168
 169 =item --stow
 170
 171 Stow the packages that follow this option into the target directory.
 172 This is the default action and so can be omitted if you are only
 173 stowing packages rather than performing a mixture of
 174 stow/delete/restow actions.
 175
 176 =item -D
 177
 178 =item --delete
 179
 180 Unstow the packages that follow this option from the target directory rather
 181 than installing them.
 182
 183 =item -R
 184
 185 =item --restow
 186
 187 Restow packages (first unstow, then stow again). This is useful
 188 for pruning obsolete symlinks from the target tree after updating
 189 the software in a package.
 190
 191 =item --adopt
 192
 193 B<Warning!>  This behaviour is specifically intended to alter the
 194 contents of your stow directory.  If you do not want that, this option
 195 is not for you.
 196
 197 When stowing, if a target is encountered which already exists but is a
 198 plain file (and hence not owned by any existing stow package), then
 199 normally Stow will register this as a conflict and refuse to proceed.
 200 This option changes that behaviour so that the file is moved to the
 201 same relative place within the package's installation image within the
 202 stow directory, and then stowing proceeds as before.  So effectively,
 203 the file becomes adopted by the stow package, without its contents
 204 changing.
 205
 206 =item --no-folding
 207
 208 Disable folding of newly stowed directories when stowing, and
 209 refolding of newly foldable directories when unstowing.
 210
 211 =item --ignore=REGEX
 212
 213 Ignore files ending in this Perl regex.
 214
 215 =item --defer=REGEX
 216
 217 Don't stow files beginning with this Perl regex if the file is already
 218 stowed to another package.
 219
 220 =item --override=REGEX
 221
 222 Force stowing files beginning with this Perl regex if the file is
 223 already stowed to another package.
 224
 225 =item --dotfiles
 226
 227 Enable special handling for "dotfiles" (files or folders whose name
 228 begins with a period) in the package directory. If this option is
 229 enabled, Stow will add a preprocessing step for each file or folder
 230 whose name begins with "dot-", and replace the "dot-" prefix in the
 231 name by a period (.). This is useful when Stow is used to manage
 232 collections of dotfiles, to avoid having a package directory full of
 233 hidden files.
 234
 235 For example, suppose we have a package containing two files,
 236 F<stow/dot-bashrc> and F<stow/dot-emacs.d/init.el>. With this option,
 237 Stow will create symlinks from F<.bashrc> to F<stow/dot-bashrc> and
 238 from F<.emacs.d/init.el> to F<stow/dot-emacs.d/init.el>. Any other
 239 files, whose name does not begin with "dot-", will be processed as usual.
 240
 241 =item -V
 242
 243 =item --version
 244
 245 Show Stow version number, and exit.
 246
 247 =item -h
 248
 249 =item --help
 250
 251 Show Stow command syntax, and exit.
 252
 253 =back
 254
 255 =head1 INSTALLING PACKAGES
 256
 257 The default action of Stow is to install a package. This means
 258 creating symlinks in the target tree that point into the package tree.
 259 Stow attempts to do this with as few symlinks as possible; in other
 260 words, if Stow can create a single symlink that points to an entire
 261 subtree within the package tree, it will choose to do that rather than
 262 create a directory in the target tree and populate it with symlinks.
 263
 264 For example, suppose that no packages have yet been installed in
 265 F</usr/local>; it's completely empty (except for the F<stow>
 266 subdirectory, of course). Now suppose the Perl package is installed.
 267 Recall that it includes the following directories in its installation
 268 image: F<bin>; F<info>; F<lib/perl>; F<man/man1>.  Rather than
 269 creating the directory F</usr/local/bin> and populating it with
 270 symlinks to F<../stow/perl/bin/perl> and F<../stow/perl/bin/a2p> (and
 271 so on), Stow will create a single symlink, F</usr/local/bin>, which
 272 points to F<stow/perl/bin>.  In this way, it still works to refer to
 273 F</usr/local/bin/perl> and F</usr/local/bin/a2p>, and fewer symlinks
 274 have been created. This is called "tree folding", since an entire
 275 subtree is "folded" into a single symlink.
 276
 277 To complete this example, Stow will also create the symlink
 278 F</usr/local/info> pointing to F<stow/perl/info>; the symlink
 279 F</usr/local/lib> pointing to F<stow/perl/lib>; and the symlink
 280 F</usr/local/man> pointing to F<stow/perl/man>.
 281
 282 Now suppose that instead of installing the Perl package into an empty
 283 target tree, the target tree is not empty to begin with. Instead, it
 284 contains several files and directories installed under a different
 285 system-administration philosophy. In particular, F</usr/local/bin>
 286 already exists and is a directory, as are F</usr/local/lib> and
 287 F</usr/local/man/man1>.  In this case, Stow will descend into
 288 F</usr/local/bin> and create symlinks to F<../stow/perl/bin/perl> and
 289 F<../stow/perl/bin/a2p> (etc.), and it will descend into
 290 F</usr/local/lib> and create the tree-folding symlink F<perl> pointing
 291 to F<../stow/perl/lib/perl>, and so on. As a rule, Stow only descends
 292 as far as necessary into the target tree when it can create a
 293 tree-folding symlink.
 294
 295 The time often comes when a tree-folding symlink has to be undone
 296 because another package uses one or more of the folded subdirectories
 297 in its installation image. This operation is called "splitting open"
 298 a folded tree. It involves removing the original symlink from the
 299 target tree, creating a true directory in its place, and then
 300 populating the new directory with symlinks to the newly-installed
 301 package B<and> to the old package that used the old symlink. For
 302 example, suppose that after installing Perl into an empty
 303 F</usr/local>, we wish to install Emacs.  Emacs's installation image
 304 includes a F<bin> directory containing the F<emacs> and F<etags>
 305 executables, among others. Stow must make these files appear to be
 306 installed in F</usr/local/bin>, but presently F</usr/local/bin> is a
 307 symlink to F<stow/perl/bin>.  Stow therefore takes the following
 308 steps: the symlink F</usr/local/bin> is deleted; the directory
 309 F</usr/local/bin> is created; links are made from F</usr/local/bin> to
 310 F<../stow/emacs/bin/emacs> and F<../stow/emacs/bin/etags>; and links
 311 are made from F</usr/local/bin> to F<../stow/perl/bin/perl> and
 312 F<../stow/perl/bin/a2p>.
 313
 314 When splitting open a folded tree, Stow makes sure that the symlink
 315 it is about to remove points inside a valid package in the current stow
 316 directory.
 317
 318 =head2 Stow will never delete anything that it doesn't own.
 319
 320 Stow "owns" everything living in the target tree that points into a
 321 package in the stow directory. Anything Stow owns, it can recompute if
 322 lost. Note that by this definition, Stow doesn't "own" anything
 323 B<in> the stow directory or in any of the packages.
 324
 325 If Stow needs to create a directory or a symlink in the target tree
 326 and it cannot because that name is already in use and is not owned by
 327 Stow, then a conflict has arisen. See the "Conflicts" section in the
 328 info manual.
 329
 330 =head1 DELETING PACKAGES
 331
 332 When the C<-D> option is given, the action of Stow is to delete a
 333 package from the target tree. Note that Stow will not delete anything
 334 it doesn't "own". Deleting a package does B<not> mean removing it from
 335 the stow directory or discarding the package tree.
 336
 337 To delete a package, Stow recursively scans the target tree, skipping
 338 over the stow directory (since that is usually a subdirectory of the
 339 target tree) and any other stow directories it encounters (see
 340 "Multiple stow directories" in the info manual). Any symlink it
 341 finds that points into the package being deleted is removed. Any
 342 directory that contained only symlinks to the package being deleted is
 343 removed. Any directory that, after removing symlinks and empty
 344 subdirectories, contains only symlinks to a single other package, is
 345 considered to be a previously "folded" tree that was "split open."
 346 Stow will re-fold the tree by removing the symlinks to the surviving
 347 package, removing the directory, then linking the directory back to
 348 the surviving package.
 349
 350 =head1 RESOURCE FILES
 351
 352 F<Stow> searches for default command line options at F<.stowrc> (current
 353 directory) and F<~/.stowrc> (home directory) in that order. If both
 354 locations are present, the files are effectively appended together.
 355
 356 The effect of options in the resource file is similar to simply prepending
 357 the options to the command line. For options that provide a single value,
 358 such as F<--target> or F<--dir>, the command line option will overwrite any
 359 options in the resource file. For options that can be given more than once,
 360 F<--ignore> for example, command line options and resource options are
 361 appended together.
 362
 363 Environment variables and the tilde character (F<~>) will be expanded for
 364 options that take a file path.
 365
 366 The options F<-D>, F<-R>, F<-S>, and any packages listed in the resource
 367 file are ignored.
 368
 369 See the info manual for more information on how stow handles resource
 370 file.
 371
 372 =head1 SEE ALSO
 373
 374 The full documentation for F<stow> is maintained as a Texinfo manual.
 375 If the F<info> and F<stow> programs are properly installed at your site, the command
 376
 377     info stow
 378
 379 should give you access to the complete manual.
 380
 381 =head1 BUGS
 382
 383 Please report bugs in Stow using the Debian bug tracking system.
 384
 385 Currently known bugs include:
 386
 387 =over 4
 388
 389 =item * The empty-directory problem.
 390
 391 If package F<foo> includes an empty directory -- say, F<foo/bar> --
 392 then if no other package has a F<bar> subdirectory, everything's fine.
 393 If another stowed package F<quux>, has a F<bar> subdirectory, then
 394 when stowing, F<targetdir/bar> will be "split open" and the contents
 395 of F<quux/bar> will be individually stowed.  So far, so good. But when
 396 unstowing F<quux>, F<targetdir/bar> will be removed, even though
 397 F<foo/bar> needs it to remain.  A workaround for this problem is to
 398 create a file in F<foo/bar> as a placeholder. If you name that file
 399 F<.placeholder>, it will be easy to find and remove such files when
 400 this bug is fixed.
 401
 402 =item *
 403
 404 When using multiple stow directories (see "Multiple stow directories"
 405 in the info manual), Stow fails to "split open" tree-folding symlinks
 406 (see "Installing packages" in the info manual) that point into a stow
 407 directory which is not the one in use by the current Stow
 408 command. Before failing, it should search the target of the link to
 409 see whether any element of the path contains a F<.stow> file. If it
 410 finds one, it can "learn" about the cooperating stow directory to
 411 short-circuit the F<.stow> search the next time it encounters a
 412 tree-folding symlink.
 413
 414 =back
 415
 416 =head1 AUTHOR
 417
 418 This man page was originally constructed by Charles Briscoe-Smith from
 419 parts of Stow's info manual, and then converted to POD format by Adam
 420 Spiers.  The info manual contains the following notice, which, as it
 421 says, applies to this manual page, too.  The text of the section
 422 entitled "GNU General Public License" can be found in the file
 423 F</usr/share/common-licenses/GPL> on any Debian GNU/Linux system.  If
 424 you don't have access to a Debian system, or the GPL is not there,
 425 write to the Free Software Foundation, Inc., 59 Temple Place, Suite
 426 330, Boston, MA, 02111-1307, USA.
 427
 428 =head1 COPYRIGHT
 429
 430 Copyright (C)
 431 1993, 1994, 1995, 1996 by Bob Glickstein <bobg+stow@zanshin.com>;
 432 2000, 2001 by Guillaume Morin;
 433 2007 by Kahlil Hodgson;
 434 2011 by Adam Spiers;
 435 and others.
 436
 437 Permission is granted to make and distribute verbatim copies of this
 438 manual provided the copyright notice and this permission notice are
 439 preserved on all copies.
 440
 441 Permission is granted to copy and distribute modified versions of this
 442 manual under the conditions for verbatim copying, provided also that
 443 the section entitled "GNU General Public License" is included with the
 444 modified manual, and provided that the entire resulting derived work
 445 is distributed under the terms of a permission notice identical to
 446 this one.
 447
 448 Permission is granted to copy and distribute translations of this
 449 manual into another language, under the above conditions for modified
 450 versions, except that this permission notice may be stated in a
 451 translation approved by the Free Software Foundation.
 452
 453 =cut
 454
 455 use strict;
 456 use warnings;
 457
 458 require 5.006_001;
 459
 460 use POSIX qw(getcwd);
 461 use Getopt::Long qw(GetOptionsFromArray);
 462 use Scalar::Util qw(reftype);
 463
 464 @USE_LIB_PMDIR@
 465 use Stow;
 466 use Stow::Util qw(parent error);
 467
 468 my $ProgramName = $0;
 469 $ProgramName =~ s{.*/}{};
 470
 471 main() unless caller();
 472
 473 sub main {
 474     my ($options, $pkgs_to_unstow, $pkgs_to_stow) = process_options();
 475
 476     my $stow = new Stow(%$options);
 477     # current dir is now the target directory
 478
 479     $stow->plan_unstow(@$pkgs_to_unstow);
 480     $stow->plan_stow  (@$pkgs_to_stow);
 481
 482     my %conflicts = $stow->get_conflicts;
 483
 484     if (%conflicts) {
 485         foreach my $action ('unstow', 'stow') {
 486             next unless $conflicts{$action};
 487             foreach my $package (sort keys %{ $conflicts{$action} }) {
 488                 warn "WARNING! ${action}ing $package would cause conflicts:\n";
 489                     #if $stow->get_action_count > 1;
 490                 foreach my $message (sort @{ $conflicts{$action}{$package} }) {
 491                     warn "  * $message\n";
 492                 }
 493             }
 494         }
 495         warn "All operations aborted.\n";
 496         exit 1;
 497     }
 498     else {
 499         if ($options->{simulate}) {
 500             warn "WARNING: in simulation mode so not modifying filesystem.\n";
 501             return;
 502         }
 503
 504         $stow->process_tasks();
 505     }
 506 }
 507
 508
 509 #===== SUBROUTINE ===========================================================
 510 # Name      : process_options()
 511 # Purpose   : Parse and process command line and .stowrc file options
 512 # Parameters: none
 513 # Returns   : (\%options, \@pkgs_to_unstow, \@pkgs_to_stow)
 514 # Throws    : a fatal error if a bad option is given
 515 # Comments  : checks @ARGV for valid package names
 516 #============================================================================
 517 sub process_options {
 518     # Get cli options.
 519     my ($cli_options,
 520         $pkgs_to_unstow,
 521         $pkgs_to_stow) = parse_options(@ARGV);
 522
 523     # Get the .stowrc options.
 524     # Note that rc_pkgs_to_unstow and rc_pkgs_to_stow are ignored.
 525     my ($rc_options,
 526         $rc_pkgs_to_unstow,
 527         $rc_pkgs_to_stow) = get_config_file_options();
 528
 529     # Merge .stowrc and command line options.
 530     # Preference is given to cli options.
 531     my %options = %$rc_options;
 532     foreach my $option (keys %$cli_options) {
 533         my $rc_value = $rc_options->{$option};
 534         my $cli_value = $cli_options->{$option};
 535         my $type = reftype($cli_value);
 536
 537         if (defined $type && $type eq 'ARRAY' && defined $rc_value) {
 538             # rc options come first in merged arrays.
 539             $options{$option} = [@{$rc_value}, @{$cli_value}];
 540         } else {
 541             # cli options overwrite conflicting rc options.
 542             $options{$option} = $cli_value;
 543         }
 544     }
 545
 546     # Run checks on the merged options.
 547     sanitize_path_options(\%options);
 548     check_packages($pkgs_to_unstow, $pkgs_to_stow);
 549
 550     # Return merged and processed options.
 551     return (\%options, $pkgs_to_unstow, $pkgs_to_stow);
 552 }
 553
 554 #===== SUBROUTINE ===========================================================
 555 # Name      : parse_options()
 556 # Purpose   : parse command line options
 557 # Parameters: @arg_array => array of options to parse
 558 #             Example: parse_options(@ARGV)
 559 # Returns   : (\%options, \@pkgs_to_unstow, \@pkgs_to_stow)
 560 # Throws    : a fatal error if a bad command line option is given
 561 # Comments  : Used for parsing both command line options and rc file. Used
 562 #             for parsing only. Sanity checks and post-processing belong in
 563 #             process_options().
 564 #============================================================================
 565 sub parse_options {
 566     my %options        = ();
 567     my @pkgs_to_unstow = ();
 568     my @pkgs_to_stow   = ();
 569     my $action = 'stow';
 570
 571     #$,="\n"; print @_,"\n"; # for debugging rc file
 572
 573     Getopt::Long::config('no_ignore_case', 'bundling', 'permute');
 574     GetOptionsFromArray(
 575         \@_,
 576         \%options,
 577         'verbose|v:+', 'help|h', 'simulate|n|no',
 578         'version|V', 'compat|p', 'dir|d=s', 'target|t=s',
 579         'adopt', 'no-folding', 'dotfiles',
 580
 581         # clean and pre-compile any regex's at parse time
 582         'ignore=s' =>
 583         sub {
 584             my $regex = $_[1];
 585             push @{$options{ignore}}, qr($regex\z);
 586         },
 587
 588         'override=s' =>
 589         sub {
 590             my $regex = $_[1];
 591             push @{$options{override}}, qr(\A$regex);
 592         },
 593
 594         'defer=s' =>
 595         sub {
 596             my $regex = $_[1];
 597             push @{$options{defer}}, qr(\A$regex);
 598         },
 599
 600         # a little craziness so we can do different actions on the same line:
 601         # a -D, -S, or -R changes the action that will be performed on the
 602         # package arguments that follow it.
 603         'D|delete'  => sub { $action = 'unstow' },
 604         'S|stow'    => sub { $action = 'stow'   },
 605         'R|restow'  => sub { $action = 'restow' },
 606
 607         # Handler for non-option arguments
 608         '<>' =>
 609         sub {
 610             if ($action eq 'restow') {
 611                 push @pkgs_to_unstow, $_[0];
 612                 push @pkgs_to_stow, $_[0];
 613             }
 614             elsif ($action eq 'unstow') {
 615                 push @pkgs_to_unstow, $_[0];
 616             }
 617             else {
 618                 push @pkgs_to_stow, $_[0];
 619             }
 620         },
 621     ) or usage('');
 622
 623     usage()   if $options{help};
 624     version() if $options{version};
 625
 626     return (\%options, \@pkgs_to_unstow, \@pkgs_to_stow);
 627 }
 628
 629 sub sanitize_path_options {
 630     my ($options) = @_;
 631
 632     unless (exists $options->{dir}) {
 633         $options->{dir} = length $ENV{STOW_DIR} ? $ENV{STOW_DIR} : getcwd();
 634     }
 635
 636     usage("--dir value '$options->{dir}' is not a valid directory")
 637         unless -d $options->{dir};
 638
 639     if (exists $options->{target}) {
 640         usage("--target value '$options->{target}' is not a valid directory")
 641             unless -d $options->{target};
 642     }
 643     else {
 644         $options->{target} = parent($options->{dir}) || '.';
 645     }
 646 }
 647
 648 sub check_packages {
 649     my ($pkgs_to_stow, $pkgs_to_unstow) = @_;
 650
 651     if (not @$pkgs_to_stow and not @$pkgs_to_unstow) {
 652         usage("No packages to stow or unstow");
 653     }
 654
 655     # check package arguments
 656     for my $package (@$pkgs_to_stow, @$pkgs_to_unstow) {
 657         $package =~ s{/+$}{};    # delete trailing slashes
 658         if ($package =~ m{/}) {
 659             error("Slashes are not permitted in package names");
 660         }
 661     }
 662 }
 663
 664 #===== SUBROUTINE ============================================================
 665 # Name      : get_config_file_options()
 666 # Purpose   : search for default settings in any .stowrc files
 667 # Parameters: none
 668 # Returns   : (\%rc_options, \@rc_pkgs_to_unstow, \@rc_pkgs_to_stow)
 669 # Throws    : a fatal error if a bad option is given
 670 # Comments  : Parses the contents of '~/.stowrc' and '.stowrc' with the same
 671 #             parser as the command line options. Additionally expands any
 672 #             environment variables or ~ character in --target or --dir
 673 #             options.
 674 #=============================================================================
 675 sub get_config_file_options {
 676     my @defaults = ();
 677     my @dirlist = ('.stowrc');
 678     if (defined($ENV{HOME})) {
 679         unshift(@dirlist, "$ENV{HOME}/.stowrc");
 680     }
 681     for my $file (@dirlist) {
 682         if (-r $file) {
 683             open my $FILE, '<', $file
 684                 or die "Could not open $file for reading\n";
 685             while (my $line = <$FILE>){
 686                 chomp $line;
 687                 push @defaults, split " ", $line;
 688             }
 689             close $FILE or die "Could not close open file: $file\n";
 690         }
 691     }
 692
 693     # Parse the options
 694     my ($rc_options, $rc_pkgs_to_unstow, $rc_pkgs_to_stow) = parse_options(@defaults);
 695
 696     # Expand environment variables and glob characters.
 697     if (exists $rc_options->{target}) {
 698         $rc_options->{target} =
 699             expand_filepath($rc_options->{target}, '--target option');
 700     }
 701     if (exists $rc_options->{dir}) {
 702         $rc_options->{dir} =
 703             expand_filepath($rc_options->{dir}, '--dir option');
 704     }
 705
 706     return ($rc_options, $rc_pkgs_to_unstow, $rc_pkgs_to_stow);
 707 }
 708
 709 #===== SUBROUTINE ============================================================
 710 # Name      : expand_filepath()
 711 # Purpose   : Handles expansions that need to be applied to
 712 #           : file paths. Currently expands environment
 713 #           : variables and the tilde.
 714 # Parameters: $path => string to perform expansion on.
 715 #           : $source => where the string came from
 716 # Returns   : String with replacements performed.
 717 # Throws    : n/a
 718 # Comments  : n/a
 719 #=============================================================================
 720 sub expand_filepath {
 721     my ($path, $source) = @_;
 722
 723     $path = expand_environment($path, $source);
 724     $path = expand_tilde($path);
 725
 726     return $path;
 727 }
 728
 729 #===== SUBROUTINE ============================================================
 730 # Name      : expand_environment()
 731 # Purpose   : Expands evironment variables.
 732 # Parameters: $path => string to perform expansion on.
 733 #           : $source => where the string came from
 734 # Returns   : String with replacements performed.
 735 # Throws    : n/a
 736 # Comments  : Variable replacement mostly based on SO answer
 737 #           : http://stackoverflow.com/a/24675093/558820
 738 #=============================================================================
 739 sub expand_environment {
 740     my ($path, $source) = @_;
 741     # Replace non-escaped $VAR and ${VAR} with $ENV{VAR}
 742     # If $ENV{VAR} does not exist, perl will raise a warning
 743     # and then happily treat it as an empty string.
 744     $path =~ s/(?<!\\)\$\{((?:\w|\s)+)\}/
 745                _safe_expand_env_var($1, $source)
 746               /ge;
 747     $path =~ s/(?<!\\)\$(\w+)/
 748                _safe_expand_env_var($1, $source)
 749               /ge;
 750     # Remove \$ escapes.
 751     $path =~ s/\\\$/\$/g;
 752     return $path;
 753 }
 754
 755 sub _safe_expand_env_var {
 756     my ($var, $source) = @_;
 757     unless (exists $ENV{$var}) {
 758         die "$source references undefined environment variable \$$var; " .
 759             "aborting!\n";
 760     }
 761     return $ENV{$var};
 762 }
 763
 764 #===== SUBROUTINE ============================================================
 765 # Name      : expand_tilde()
 766 # Purpose   : Expands tilde to user's home directory path.
 767 # Parameters: $path => string to perform expansion on.
 768 # Returns   : String with replacements performed.
 769 # Throws    : n/a
 770 # Comments  : http://docstore.mik.ua/orelly/perl4/cook/ch07_04.htm
 771 #=============================================================================
 772 sub expand_tilde {
 773     my ($path) = @_;
 774     # Replace tilde with home path.
 775         $path =~ s{ ^ ~ ( [^/]* ) }
 776                   { $1
 777                     ? (getpwnam($1))[7]
 778                     : ( $ENV{HOME} || $ENV{LOGDIR}
 779                          || (getpwuid($<))[7]
 780                       )
 781     }ex;
 782     # Replace espaced tilde with regular tilde.
 783     $path =~ s/\\~/~/g;
 784         return $path
 785 }
 786
 787
 788 #===== SUBROUTINE ===========================================================
 789 # Name      : usage()
 790 # Purpose   : print program usage message and exit
 791 # Parameters: $msg => string to prepend to the usage message
 792 # Returns   : n/a
 793 # Throws    : n/a
 794 # Comments  : if 'msg' is given, then exit with non-zero status
 795 #============================================================================
 796 sub usage {
 797     my ($msg) = @_;
 798
 799     if ($msg) {
 800         warn "$ProgramName: $msg\n\n";
 801     }
 802
 803     print <<"EOT";
 804 $ProgramName (GNU Stow) version $Stow::VERSION
 805
 806 SYNOPSIS:
 807
 808     $ProgramName [OPTION ...] [-D|-S|-R] PACKAGE ... [-D|-S|-R] PACKAGE ...
 809
 810 OPTIONS:
 811
 812     -d DIR, --dir=DIR     Set stow dir to DIR (default is current dir)
 813     -t DIR, --target=DIR  Set target to DIR (default is parent of stow dir)
 814
 815     -S, --stow            Stow the package names that follow this option
 816     -D, --delete          Unstow the package names that follow this option
 817     -R, --restow          Restow (like stow -D followed by stow -S)
 818
 819     --ignore=REGEX        Ignore files ending in this Perl regex
 820     --defer=REGEX         Don't stow files beginning with this Perl regex
 821                           if the file is already stowed to another package
 822     --override=REGEX      Force stowing files beginning with this Perl regex
 823                           if the file is already stowed to another package
 824     --adopt               (Use with care!)  Import existing files into stow package
 825                           from target.  Please read docs before using.
 826     --dotfiles            Enables special handling for dotfiles that are
 827                           Stow packages that start with "dot-" and not "."
 828     -p, --compat          Use legacy algorithm for unstowing
 829
 830     -n, --no, --simulate  Do not actually make any filesystem changes
 831     -v, --verbose[=N]     Increase verbosity (levels are from 0 to 5;
 832                             -v or --verbose adds 1; --verbose=N sets level)
 833     -V, --version         Show stow version number
 834     -h, --help            Show this help
 835
 836 Report bugs to: bug-stow\@gnu.org
 837 Stow home page: <http://www.gnu.org/software/stow/>
 838 General help using GNU software: <http://www.gnu.org/gethelp/>
 839 EOT
 840     exit defined $msg ? 1 : 0;
 841 }
 842
 843 sub version {
 844     print "$ProgramName (GNU Stow) version $Stow::VERSION\n";
 845     exit 0;
 846 }
 847
 848 1; # This file is required by t/stow.t
 849
 850 # Local variables:
 851 # mode: perl
 852 # end:
 853 # vim: ft=perl