File Coverage

bin/stow
Criterion Covered Total %
statement 123 147 83.6
branch 37 54 68.5
condition 8 14 57.1
subroutine 26 27 96.3
pod n/a
total 194 242 80.1


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