File Coverage

bin/stow
Criterion Covered Total %
statement 111 140 79.2
branch 31 52 59.6
condition 8 14 57.1
subroutine 23 26 88.4
pod n/a
total 173 232 74.5


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