Migrate from .stow-rename to --dotfiles
This commit is contained in:
parent
23daff4a9f
commit
d3ba668350
43 changed files with 0 additions and 1 deletions
128
dot-local/bin/chkstow
Executable file
128
dot-local/bin/chkstow
Executable file
|
@ -0,0 +1,128 @@
|
|||
#!/usr/local/bin/perl
|
||||
#
|
||||
# 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/.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require 5.006_001;
|
||||
|
||||
use File::Find;
|
||||
use Getopt::Long;
|
||||
|
||||
my $DEFAULT_TARGET = $ENV{STOW_DIR} || '/usr/local/';
|
||||
|
||||
our $Wanted = \&bad_links;
|
||||
our %Package = ();
|
||||
our $Stow_dir = '';
|
||||
our $Target = $DEFAULT_TARGET;
|
||||
|
||||
# put the main loop into a block so that tests can load this as a module
|
||||
if ( not caller() ) {
|
||||
if (@ARGV == 0) {
|
||||
usage();
|
||||
}
|
||||
process_options();
|
||||
#check_stow($Target, $Wanted);
|
||||
check_stow();
|
||||
}
|
||||
|
||||
sub process_options {
|
||||
GetOptions(
|
||||
'b|badlinks' => sub { $Wanted = \&bad_links },
|
||||
'a|aliens' => sub { $Wanted = \&aliens },
|
||||
'l|list' => sub { $Wanted = \&list },
|
||||
't|target=s' => \$Target,
|
||||
) or usage();
|
||||
return;
|
||||
}
|
||||
|
||||
sub usage {
|
||||
print <<"EOT";
|
||||
USAGE: chkstow [options]
|
||||
|
||||
Options:
|
||||
-t DIR, --target=DIR Set the target directory to DIR
|
||||
(default is $DEFAULT_TARGET)
|
||||
-b, --badlinks Report symlinks that point to non-existent files
|
||||
-a, --aliens Report non-symlinks in the target directory
|
||||
-l, --list List packages in the target directory
|
||||
|
||||
--badlinks is the default mode.
|
||||
EOT
|
||||
exit(0);
|
||||
}
|
||||
|
||||
sub check_stow {
|
||||
#my ($Target, $Wanted) = @_;
|
||||
|
||||
my (%options) = (
|
||||
wanted => $Wanted,
|
||||
preprocess => \&skip_dirs,
|
||||
);
|
||||
|
||||
find(\%options, $Target);
|
||||
|
||||
if ($Wanted == \&list) {
|
||||
delete $Package{''};
|
||||
delete $Package{'..'};
|
||||
|
||||
if (keys %Package) {
|
||||
print map "$_\n", sort(keys %Package);
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub skip_dirs {
|
||||
# skip stow source and unstowed targets
|
||||
if (-e ".stow" || -e ".notstowed" ) {
|
||||
warn "skipping $File::Find::dir\n";
|
||||
return ();
|
||||
}
|
||||
else {
|
||||
return @_;
|
||||
}
|
||||
}
|
||||
|
||||
# checking for files that do not link to anything
|
||||
sub bad_links {
|
||||
-l && !-e && print "Bogus link: $File::Find::name\n";
|
||||
}
|
||||
|
||||
# checking for files that are not owned by stow
|
||||
sub aliens {
|
||||
!-l && !-d && print "Unstowed file: $File::Find::name\n";
|
||||
}
|
||||
|
||||
# just list the packages in the target directory
|
||||
# FIXME: what if the stow dir is not called 'stow'?
|
||||
sub list {
|
||||
if (-l) {
|
||||
$_ = readlink;
|
||||
s{\A(?:\.\./)+stow/}{}g;
|
||||
s{/.*}{}g;
|
||||
$Package{$_} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
1; # Hey, it's a module!
|
||||
|
||||
# Local variables:
|
||||
# mode: perl
|
||||
# cperl-indent-level: 4
|
||||
# End:
|
||||
# vim: ft=perl
|
854
dot-local/bin/stow
Executable file
854
dot-local/bin/stow
Executable file
|
@ -0,0 +1,854 @@
|
|||
#!/usr/local/bin/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 2.3.2-fixbug56727. 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
|
||||
|
||||
=item --simulate
|
||||
|
||||
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 --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 FindBin; use lib "$FindBin::Bin/../lib/perl";
|
||||
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',
|
||||
|
||||
# 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)
|
||||
|
||||
--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.
|
||||
--dotfiles Enables special handling for dotfiles that are
|
||||
Stow packages that start with "dot-" and not "."
|
||||
-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
|
Loading…
Add table
Add a link
Reference in a new issue