stow/bin/stow.in

#!@PERL@

# GNU Stow - manage farms of symbolic links
# Copyright (C) 1993, 1994, 1995, 1996 by Bob Glickstein
# Copyright (C) 2000, 2001 Guillaume Morin
# Copyright (C) 2007 Kahlil Hodgson
# Copyright (C) 2011 Adam Spiers
#
# This file is part of GNU Stow.
#
# GNU Stow is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# GNU Stow is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see https://www.gnu.org/licenses/.

=head1 NAME

stow - manage farms of symbolic links

=head1 SYNOPSIS

stow [ options ] package ...

=head1 DESCRIPTION

This manual page describes GNU Stow @VERSION@.  This is not the
definitive documentation for Stow; for that, see the accompanying info
manual, e.g. by typing C<info stow>.

Stow is a symlink farm manager which takes distinct sets of software
and/or data located in separate directories on the filesystem, and
makes them all appear to be installed in a single directory tree.

Originally Stow was born to address the need to administer, upgrade,
install, and remove files in independent software packages without
confusing them with other files sharing the same file system space.
For instance, many years ago it used to be common to compile programs
such as Perl and Emacs from source.  By using Stow, F</usr/local/bin>
could contain symlinks to files within F</usr/local/stow/emacs/bin>,
F</usr/local/stow/perl/bin> etc., and likewise recursively for any
other subdirectories such as F<.../share>, F<.../man>, and so on.

While this is useful for keeping track of system-wide and per-user
installations of software built from source, in more recent times
software packages are often managed by more sophisticated package
management software such as rpm, dpkg, and Nix / GNU Guix, or
language-native package managers such as Ruby's gem, Python's pip,
Javascript's npm, and so on.

However Stow is still used not only for software package management,
but also for other purposes, such as facilitating a more controlled
approach to management of configuration files in the user's home
directory, especially when coupled with version control systems.

Stow was inspired by Carnegie Mellon's Depot program, but is
substantially simpler and safer. Whereas Depot required database files
to keep things in sync, Stow stores no extra state between runs, so
there's no danger (as there was in Depot) of mangling directories when
file hierarchies don't match the database. Also unlike Depot, Stow
will never delete any files, directories, or links that appear in a
Stow directory (e.g., F</usr/local/stow/emacs>), so it's always
possible to rebuild the target tree (e.g., F</usr/local>).

Stow is implemented as a combination of a Perl script providing a CLI
interface, and a backend Perl module which does most of the work.

=head1 TERMINOLOGY

A "package" is a related collection of files and directories that
you wish to administer as a unit -- e.g., Perl or Emacs -- and that
needs to be installed in a particular directory structure -- e.g.,
with F<bin>, F<lib>, and F<man> subdirectories.

A "target directory" is the root of a tree in which one or more
packages wish to B<appear> to be installed. A common, but by no means
the only such location is F</usr/local>.  The examples in this manual
page will use F</usr/local> as the target directory.

A "stow directory" is the root of a tree containing separate
packages in private subtrees. When Stow runs, it uses the current
directory as the default stow directory. The examples in this manual
page will use F</usr/local/stow> as the stow directory, so that
individual packages will be, for example, F</usr/local/stow/perl> and
F</usr/local/stow/emacs>.

An "installation image" is the layout of files and directories
required by a package, relative to the target directory. Thus, the
installation image for Perl includes: a F<bin> directory containing
F<perl> and F<a2p> (among others); an F<info> directory containing
Texinfo documentation; a F<lib/perl> directory containing Perl
libraries; and a F<man/man1> directory containing man pages.

A "package directory" is the root of a tree containing the
installation image for a particular package. Each package directory
must reside in a stow directory -- e.g., the package directory
F</usr/local/stow/perl> must reside in the stow directory
F</usr/local/stow>.  The "name" of a package is the name of its
directory within the stow directory -- e.g., F<perl>.

Thus, the Perl executable might reside in
F</usr/local/stow/perl/bin/perl>, where F</usr/local> is the target
directory, F</usr/local/stow> is the stow directory,
F</usr/local/stow/perl> is the package directory, and F<bin/perl>
within is part of the installation image.

A "symlink" is a symbolic link. A symlink can be "relative" or
"absolute". An absolute symlink names a full path; that is, one
starting from F</>.  A relative symlink names a relative path; that
is, one not starting from F</>.  The target of a relative symlink is
computed starting from the symlink's own directory.  Stow only creates
relative symlinks.

=head1 OPTIONS

The stow directory is assumed to be the value of the C<STOW_DIR>
environment variable or if unset the current directory, and the target
directory is assumed to be the parent of the current directory (so it
is typical to execute F<stow> from the directory F</usr/local/stow>).
Each F<package> given on the command line is the name of a package in
the stow directory (e.g., F<perl>).  By default, they are installed
into the target directory (but they can be deleted instead using
C<-D>).

=over 4

=item -n

=item --no

Do not perform any operations that modify the filesystem; merely show
what would happen.

=item -d DIR

=item --dir=DIR

Set the stow directory to C<DIR> instead of the current directory.
This also has the effect of making the default target directory be the
parent of C<DIR>.

=item -t DIR

=item --target=DIR

Set the target directory to C<DIR> instead of the parent of the stow
directory.

=item -v

=item --verbose[=N]

Send verbose output to standard error describing what Stow is
doing. Verbosity levels are from 0 to 5; 0 is the default.
Using C<-v> or C<--verbose> increases the verbosity by one; using
`--verbose=N' sets it to N.

=item -S

=item --stow

Stow the packages that follow this option into the target directory.
This is the default action and so can be omitted if you are only
stowing packages rather than performing a mixture of
stow/delete/restow actions.

=item -D

=item --delete

Unstow the packages that follow this option from the target directory rather
than installing them.

=item -R

=item --restow

Restow packages (first unstow, then stow again). This is useful
for pruning obsolete symlinks from the target tree after updating
the software in a package.

=item --adopt

B<Warning!>  This behaviour is specifically intended to alter the
contents of your stow directory.  If you do not want that, this option
is not for you.

When stowing, if a target is encountered which already exists but is a
plain file (and hence not owned by any existing stow package), then
normally Stow will register this as a conflict and refuse to proceed.
This option changes that behaviour so that the file is moved to the
same relative place within the package's installation image within the
stow directory, and then stowing proceeds as before.  So effectively,
the file becomes adopted by the stow package, without its contents
changing.

=item --no-folding

Disable folding of newly stowed directories when stowing, and
refolding of newly foldable directories when unstowing.

=item --absolute

=item -a

Use absolute paths

=item --ignore=REGEX

Ignore files ending in this Perl regex.

=item --defer=REGEX

Don't stow files beginning with this Perl regex if the file is already
stowed to another package.

=item --override=REGEX

Force stowing files beginning with this Perl regex if the file is
already stowed to another package.

=item --dotfiles

Enable special handling for "dotfiles" (files or folders whose name
begins with a period) in the package directory. If this option is
enabled, Stow will add a preprocessing step for each file or folder
whose name begins with "dot-", and replace the "dot-" prefix in the
name by a period (.). This is useful when Stow is used to manage
collections of dotfiles, to avoid having a package directory full of
hidden files.

For example, suppose we have a package containing two files,
F<stow/dot-bashrc> and F<stow/dot-emacs.d/init.el>. With this option,
Stow will create symlinks from F<.bashrc> to F<stow/dot-bashrc> and
from F<.emacs.d/init.el> to F<stow/dot-emacs.d/init.el>. Any other
files, whose name does not begin with "dot-", will be processed as usual.

=item -V

=item --version

Show Stow version number, and exit.

=item -h

=item --help

Show Stow command syntax, and exit.

=back

=head1 INSTALLING PACKAGES

The default action of Stow is to install a package. This means
creating symlinks in the target tree that point into the package tree.
Stow attempts to do this with as few symlinks as possible; in other
words, if Stow can create a single symlink that points to an entire
subtree within the package tree, it will choose to do that rather than
create a directory in the target tree and populate it with symlinks.

For example, suppose that no packages have yet been installed in
F</usr/local>; it's completely empty (except for the F<stow>
subdirectory, of course). Now suppose the Perl package is installed.
Recall that it includes the following directories in its installation
image: F<bin>; F<info>; F<lib/perl>; F<man/man1>.  Rather than
creating the directory F</usr/local/bin> and populating it with
symlinks to F<../stow/perl/bin/perl> and F<../stow/perl/bin/a2p> (and
so on), Stow will create a single symlink, F</usr/local/bin>, which
points to F<stow/perl/bin>.  In this way, it still works to refer to
F</usr/local/bin/perl> and F</usr/local/bin/a2p>, and fewer symlinks
have been created. This is called "tree folding", since an entire
subtree is "folded" into a single symlink.

To complete this example, Stow will also create the symlink
F</usr/local/info> pointing to F<stow/perl/info>; the symlink
F</usr/local/lib> pointing to F<stow/perl/lib>; and the symlink
F</usr/local/man> pointing to F<stow/perl/man>.

Now suppose that instead of installing the Perl package into an empty
target tree, the target tree is not empty to begin with. Instead, it
contains several files and directories installed under a different
system-administration philosophy. In particular, F</usr/local/bin>
already exists and is a directory, as are F</usr/local/lib> and
F</usr/local/man/man1>.  In this case, Stow will descend into
F</usr/local/bin> and create symlinks to F<../stow/perl/bin/perl> and
F<../stow/perl/bin/a2p> (etc.), and it will descend into
F</usr/local/lib> and create the tree-folding symlink F<perl> pointing
to F<../stow/perl/lib/perl>, and so on. As a rule, Stow only descends
as far as necessary into the target tree when it can create a
tree-folding symlink.

The time often comes when a tree-folding symlink has to be undone
because another package uses one or more of the folded subdirectories
in its installation image. This operation is called "splitting open"
a folded tree. It involves removing the original symlink from the
target tree, creating a true directory in its place, and then
populating the new directory with symlinks to the newly-installed
package B<and> to the old package that used the old symlink. For
example, suppose that after installing Perl into an empty
F</usr/local>, we wish to install Emacs.  Emacs's installation image
includes a F<bin> directory containing the F<emacs> and F<etags>
executables, among others. Stow must make these files appear to be
installed in F</usr/local/bin>, but presently F</usr/local/bin> is a
symlink to F<stow/perl/bin>.  Stow therefore takes the following
steps: the symlink F</usr/local/bin> is deleted; the directory
F</usr/local/bin> is created; links are made from F</usr/local/bin> to
F<../stow/emacs/bin/emacs> and F<../stow/emacs/bin/etags>; and links
are made from F</usr/local/bin> to F<../stow/perl/bin/perl> and
F<../stow/perl/bin/a2p>.

When splitting open a folded tree, Stow makes sure that the symlink
it is about to remove points inside a valid package in the current stow
directory.

=head2 Stow will never delete anything that it doesn't own.

Stow "owns" everything living in the target tree that points into a
package in the stow directory. Anything Stow owns, it can recompute if
lost. Note that by this definition, Stow doesn't "own" anything
B<in> the stow directory or in any of the packages.

If Stow needs to create a directory or a symlink in the target tree
and it cannot because that name is already in use and is not owned by
Stow, then a conflict has arisen. See the "Conflicts" section in the
info manual.

=head1 DELETING PACKAGES

When the C<-D> option is given, the action of Stow is to delete a
package from the target tree. Note that Stow will not delete anything
it doesn't "own". Deleting a package does B<not> mean removing it from
the stow directory or discarding the package tree.

To delete a package, Stow recursively scans the target tree, skipping
over the stow directory (since that is usually a subdirectory of the
target tree) and any other stow directories it encounters (see
"Multiple stow directories" in the info manual). Any symlink it
finds that points into the package being deleted is removed. Any
directory that contained only symlinks to the package being deleted is
removed. Any directory that, after removing symlinks and empty
subdirectories, contains only symlinks to a single other package, is
considered to be a previously "folded" tree that was "split open."
Stow will re-fold the tree by removing the symlinks to the surviving
package, removing the directory, then linking the directory back to
the surviving package.

=head1 RESOURCE FILES

F<Stow> searches for default command line options at F<.stowrc> (current
directory) and F<~/.stowrc> (home directory) in that order. If both
locations are present, the files are effectively appended together.

The effect of options in the resource file is similar to simply prepending
the options to the command line. For options that provide a single value,
such as F<--target> or F<--dir>, the command line option will overwrite any
options in the resource file. For options that can be given more than once,
F<--ignore> for example, command line options and resource options are
appended together.

Environment variables and the tilde character (F<~>) will be expanded for
options that take a file path.

The options F<-D>, F<-R>, F<-S>, and any packages listed in the resource
file are ignored.

See the info manual for more information on how stow handles resource
file.

=head1 SEE ALSO

The full documentation for F<stow> is maintained as a Texinfo manual.
If the F<info> and F<stow> programs are properly installed at your site, the command

    info stow

should give you access to the complete manual.

=head1 BUGS

Please report bugs in Stow using the Debian bug tracking system.

Currently known bugs include:

=over 4

=item * The empty-directory problem.

If package F<foo> includes an empty directory -- say, F<foo/bar> --
then if no other package has a F<bar> subdirectory, everything's fine.
If another stowed package F<quux>, has a F<bar> subdirectory, then
when stowing, F<targetdir/bar> will be "split open" and the contents
of F<quux/bar> will be individually stowed.  So far, so good. But when
unstowing F<quux>, F<targetdir/bar> will be removed, even though
F<foo/bar> needs it to remain.  A workaround for this problem is to
create a file in F<foo/bar> as a placeholder. If you name that file
F<.placeholder>, it will be easy to find and remove such files when
this bug is fixed.

=item *

When using multiple stow directories (see "Multiple stow directories"
in the info manual), Stow fails to "split open" tree-folding symlinks
(see "Installing packages" in the info manual) that point into a stow
directory which is not the one in use by the current Stow
command. Before failing, it should search the target of the link to
see whether any element of the path contains a F<.stow> file. If it
finds one, it can "learn" about the cooperating stow directory to
short-circuit the F<.stow> search the next time it encounters a
tree-folding symlink.

=back

=head1 AUTHOR

This man page was originally constructed by Charles Briscoe-Smith from
parts of Stow's info manual, and then converted to POD format by Adam
Spiers.  The info manual contains the following notice, which, as it
says, applies to this manual page, too.  The text of the section
entitled "GNU General Public License" can be found in the file
F</usr/share/common-licenses/GPL> on any Debian GNU/Linux system.  If
you don't have access to a Debian system, or the GPL is not there,
write to the Free Software Foundation, Inc., 59 Temple Place, Suite
330, Boston, MA, 02111-1307, USA.

=head1 COPYRIGHT

Copyright (C)
1993, 1994, 1995, 1996 by Bob Glickstein <bobg+stow@zanshin.com>;
2000, 2001 by Guillaume Morin;
2007 by Kahlil Hodgson;
2011 by Adam Spiers;
and others.

Permission is granted to make and distribute verbatim copies of this
manual provided the copyright notice and this permission notice are
preserved on all copies.

Permission is granted to copy and distribute modified versions of this
manual under the conditions for verbatim copying, provided also that
the section entitled "GNU General Public License" is included with the
modified manual, and provided that the entire resulting derived work
is distributed under the terms of a permission notice identical to
this one.

Permission is granted to copy and distribute translations of this
manual into another language, under the above conditions for modified
versions, except that this permission notice may be stated in a
translation approved by the Free Software Foundation.

=cut

use strict;
use warnings;

require 5.006_001;

use POSIX qw(getcwd);
use Getopt::Long qw(GetOptionsFromArray);
use Scalar::Util qw(reftype);

@USE_LIB_PMDIR@
use Stow;
use Stow::Util qw(parent error);

my $ProgramName = $0;
$ProgramName =~ s{.*/}{};

main() unless caller();

sub main {
    my ($options, $pkgs_to_unstow, $pkgs_to_stow) = process_options();

    my $stow = new Stow(%$options);
    # current dir is now the target directory

    $stow->plan_unstow(@$pkgs_to_unstow);
    $stow->plan_stow  (@$pkgs_to_stow);

    my %conflicts = $stow->get_conflicts;

    if (%conflicts) {
        foreach my $action ('unstow', 'stow') {
            next unless $conflicts{$action};
            foreach my $package (sort keys %{ $conflicts{$action} }) {
                warn "WARNING! ${action}ing $package would cause conflicts:\n";
                    #if $stow->get_action_count > 1;
                foreach my $message (sort @{ $conflicts{$action}{$package} }) {
                    warn "  * $message\n";
                }
            }
        }
        warn "All operations aborted.\n";
        exit 1;
    }
    else {
        if ($options->{simulate}) {
            warn "WARNING: in simulation mode so not modifying filesystem.\n";
            return;
        }

        $stow->process_tasks();
    }
}


#===== SUBROUTINE ===========================================================
# Name      : process_options()
# Purpose   : Parse and process command line and .stowrc file options
# Parameters: none
# Returns   : (\%options, \@pkgs_to_unstow, \@pkgs_to_stow)
# Throws    : a fatal error if a bad option is given
# Comments  : checks @ARGV for valid package names
#============================================================================
sub process_options {
    # Get cli options.
    my ($cli_options,
        $pkgs_to_unstow,
        $pkgs_to_stow) = parse_options(@ARGV);

    # Get the .stowrc options.
    # Note that rc_pkgs_to_unstow and rc_pkgs_to_stow are ignored.
    my ($rc_options,
        $rc_pkgs_to_unstow,
        $rc_pkgs_to_stow) = get_config_file_options();

    # Merge .stowrc and command line options.
    # Preference is given to cli options.
    my %options = %$rc_options;
    foreach my $option (keys %$cli_options) {
        my $rc_value = $rc_options->{$option};
        my $cli_value = $cli_options->{$option};
        my $type = reftype($cli_value);

        if (defined $type && $type eq 'ARRAY' && defined $rc_value) {
            # rc options come first in merged arrays.
            $options{$option} = [@{$rc_value}, @{$cli_value}];
        } else {
            # cli options overwrite conflicting rc options.
            $options{$option} = $cli_value;
        }
    }

    # Run checks on the merged options.
    sanitize_path_options(\%options);
    check_packages($pkgs_to_unstow, $pkgs_to_stow);

    # Return merged and processed options.
    return (\%options, $pkgs_to_unstow, $pkgs_to_stow);
}

#===== SUBROUTINE ===========================================================
# Name      : parse_options()
# Purpose   : parse command line options
# Parameters: @arg_array => array of options to parse
#             Example: parse_options(@ARGV)
# Returns   : (\%options, \@pkgs_to_unstow, \@pkgs_to_stow)
# Throws    : a fatal error if a bad command line option is given
# Comments  : Used for parsing both command line options and rc file. Used
#             for parsing only. Sanity checks and post-processing belong in
#             process_options().
#============================================================================
sub parse_options {
    my %options        = ();
    my @pkgs_to_unstow = ();
    my @pkgs_to_stow   = ();
    my $action = 'stow';

    #$,="\n"; print @_,"\n"; # for debugging rc file

    Getopt::Long::config('no_ignore_case', 'bundling', 'permute');
    GetOptionsFromArray(
        \@_,
        \%options,
        'verbose|v:+', 'help|h', 'simulate|n|no',
        'version|V', 'compat|p', 'dir|d=s', 'target|t=s',
        'adopt', 'no-folding', 'dotfiles', 'absolute|a',

        # clean and pre-compile any regex's at parse time
        'ignore=s' =>
        sub {
            my $regex = $_[1];
            push @{$options{ignore}}, qr($regex\z);
        },

        'override=s' =>
        sub {
            my $regex = $_[1];
            push @{$options{override}}, qr(\A$regex);
        },

        'defer=s' =>
        sub {
            my $regex = $_[1];
            push @{$options{defer}}, qr(\A$regex);
        },

        # a little craziness so we can do different actions on the same line:
        # a -D, -S, or -R changes the action that will be performed on the
        # package arguments that follow it.
        'D|delete'  => sub { $action = 'unstow' },
        'S|stow'    => sub { $action = 'stow'   },
        'R|restow'  => sub { $action = 'restow' },

        # Handler for non-option arguments
        '<>' =>
        sub {
            if ($action eq 'restow') {
                push @pkgs_to_unstow, $_[0];
                push @pkgs_to_stow, $_[0];
            }
            elsif ($action eq 'unstow') {
                push @pkgs_to_unstow, $_[0];
            }
            else {
                push @pkgs_to_stow, $_[0];
            }
        },
    ) or usage('');

    usage()   if $options{help};
    version() if $options{version};

    return (\%options, \@pkgs_to_unstow, \@pkgs_to_stow);
}

sub sanitize_path_options {
    my ($options) = @_;

    unless (exists $options->{dir}) {
        $options->{dir} = length $ENV{STOW_DIR} ? $ENV{STOW_DIR} : getcwd();
    }

    usage("--dir value '$options->{dir}' is not a valid directory")
        unless -d $options->{dir};

    if (exists $options->{target}) {
        usage("--target value '$options->{target}' is not a valid directory")
            unless -d $options->{target};
    }
    else {
        $options->{target} = parent($options->{dir}) || '.';
    }
}

sub check_packages {
    my ($pkgs_to_stow, $pkgs_to_unstow) = @_;

    if (not @$pkgs_to_stow and not @$pkgs_to_unstow) {
        usage("No packages to stow or unstow");
    }

    # check package arguments
    for my $package (@$pkgs_to_stow, @$pkgs_to_unstow) {
        $package =~ s{/+$}{};    # delete trailing slashes
        if ($package =~ m{/}) {
            error("Slashes are not permitted in package names");
        }
    }
}

#===== SUBROUTINE ============================================================
# Name      : get_config_file_options()
# Purpose   : search for default settings in any .stowrc files
# Parameters: none
# Returns   : (\%rc_options, \@rc_pkgs_to_unstow, \@rc_pkgs_to_stow)
# Throws    : a fatal error if a bad option is given
# Comments  : Parses the contents of '~/.stowrc' and '.stowrc' with the same
#             parser as the command line options. Additionally expands any
#             environment variables or ~ character in --target or --dir
#             options.
#=============================================================================
sub get_config_file_options {
    my @defaults = ();
    my @dirlist = ('.stowrc');
    if (defined($ENV{HOME})) {
        unshift(@dirlist, "$ENV{HOME}/.stowrc");
    }
    for my $file (@dirlist) {
        if (-r $file) {
            open my $FILE, '<', $file
                or die "Could not open $file for reading\n";
            while (my $line = <$FILE>){
                chomp $line;
                push @defaults, split " ", $line;
            }
            close $FILE or die "Could not close open file: $file\n";
        }
    }

    # Parse the options
    my ($rc_options, $rc_pkgs_to_unstow, $rc_pkgs_to_stow) = parse_options(@defaults);

    # Expand environment variables and glob characters.
    if (exists $rc_options->{target}) {
        $rc_options->{target} =
            expand_filepath($rc_options->{target}, '--target option');
    }
    if (exists $rc_options->{dir}) {
        $rc_options->{dir} =
            expand_filepath($rc_options->{dir}, '--dir option');
    }

    return ($rc_options, $rc_pkgs_to_unstow, $rc_pkgs_to_stow);
}

#===== SUBROUTINE ============================================================
# Name      : expand_filepath()
# Purpose   : Handles expansions that need to be applied to
#           : file paths. Currently expands environment
#           : variables and the tilde.
# Parameters: $path => string to perform expansion on.
#           : $source => where the string came from
# Returns   : String with replacements performed.
# Throws    : n/a
# Comments  : n/a
#=============================================================================
sub expand_filepath {
    my ($path, $source) = @_;

    $path = expand_environment($path, $source);
    $path = expand_tilde($path);

    return $path;
}

#===== SUBROUTINE ============================================================
# Name      : expand_environment()
# Purpose   : Expands evironment variables.
# Parameters: $path => string to perform expansion on.
#           : $source => where the string came from
# Returns   : String with replacements performed.
# Throws    : n/a
# Comments  : Variable replacement mostly based on SO answer
#           : http://stackoverflow.com/a/24675093/558820
#=============================================================================
sub expand_environment {
    my ($path, $source) = @_;
    # Replace non-escaped $VAR and ${VAR} with $ENV{VAR}
    # If $ENV{VAR} does not exist, perl will raise a warning
    # and then happily treat it as an empty string.
    $path =~ s/(?<!\\)\$\{((?:\w|\s)+)\}/
               _safe_expand_env_var($1, $source)
              /ge;
    $path =~ s/(?<!\\)\$(\w+)/
               _safe_expand_env_var($1, $source)
              /ge;
    # Remove \$ escapes.
    $path =~ s/\\\$/\$/g;
    return $path;
}

sub _safe_expand_env_var {
    my ($var, $source) = @_;
    unless (exists $ENV{$var}) {
        die "$source references undefined environment variable \$$var; " .
            "aborting!\n";
    }
    return $ENV{$var};
}

#===== SUBROUTINE ============================================================
# Name      : expand_tilde()
# Purpose   : Expands tilde to user's home directory path.
# Parameters: $path => string to perform expansion on.
# Returns   : String with replacements performed.
# Throws    : n/a
# Comments  : http://docstore.mik.ua/orelly/perl4/cook/ch07_04.htm
#=============================================================================
sub expand_tilde {
    my ($path) = @_;
    # Replace tilde with home path.
	$path =~ s{ ^ ~ ( [^/]* ) }
                  { $1
                    ? (getpwnam($1))[7]
                    : ( $ENV{HOME} || $ENV{LOGDIR}
                         || (getpwuid($<))[7]
                      )
    }ex;
    # Replace espaced tilde with regular tilde.
    $path =~ s/\\~/~/g;
	return $path
}


#===== SUBROUTINE ===========================================================
# Name      : usage()
# Purpose   : print program usage message and exit
# Parameters: $msg => string to prepend to the usage message
# Returns   : n/a
# Throws    : n/a
# Comments  : if 'msg' is given, then exit with non-zero status
#============================================================================
sub usage {
    my ($msg) = @_;

    if ($msg) {
        warn "$ProgramName: $msg\n\n";
    }

    print <<"EOT";
$ProgramName (GNU Stow) version $Stow::VERSION

SYNOPSIS:

    $ProgramName [OPTION ...] [-D|-S|-R] PACKAGE ... [-D|-S|-R] PACKAGE ...

OPTIONS:

    -d DIR, --dir=DIR     Set stow dir to DIR (default is current dir)
    -t DIR, --target=DIR  Set target to DIR (default is parent of stow dir)

    -S, --stow            Stow the package names that follow this option
    -D, --delete          Unstow the package names that follow this option
    -R, --restow          Restow (like stow -D followed by stow -S)

    -a, --absolute        Use absolute paths
    --dotfiles            Convert filenames starting with `dot-' to `.'

    --no-folding          Disable folding of newly stowed directories when stowing, 
                          and refolding of newly foldable directories when unstowing.
    --ignore=REGEX        Ignore files ending in this Perl regex
    --defer=REGEX         Don't stow files beginning with this Perl regex
                          if the file is already stowed to another package
    --override=REGEX      Force stowing files beginning with this Perl regex
                          if the file is already stowed to another package
    --adopt               (Use with care!)  Import existing files into stow package
                          from target.  Please read docs before using.
    -p, --compat          Use legacy algorithm for unstowing

    -n, --no, --simulate  Do not actually make any filesystem changes
    -v, --verbose[=N]     Increase verbosity (levels are from 0 to 5;
                            -v or --verbose adds 1; --verbose=N sets level)
    -V, --version         Show stow version number
    -h, --help            Show this help

Report bugs to: bug-stow\@gnu.org
Stow home page: <http://www.gnu.org/software/stow/>
General help using GNU software: <http://www.gnu.org/gethelp/>
EOT
    exit defined $msg ? 1 : 0;
}

sub version {
    print "$ProgramName (GNU Stow) version $Stow::VERSION\n";
    exit 0;
}

1; # This file is required by t/stow.t

# Local variables:
# mode: perl
# cperl-indent-level: 4
# end:
# vim: ft=perl