diff --git a/Build.PL b/Build.PL index a14b93b..3f63c0c 100644 --- a/Build.PL +++ b/Build.PL @@ -45,6 +45,7 @@ my $build = Module::Build->new( 'perl' => '5.006', 'Carp' => 0, 'IO::File' => 0, + 'Hash::Merge' => 0, }, script_files => [ 'bin/stow', 'bin/chkstow' ], all_from => 'lib/Stow.pm.in', diff --git a/MANIFEST b/MANIFEST index 91ae7bf..ed1b9b8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -45,6 +45,7 @@ t/ignore.t t/join_paths.t t/parent.t t/stow.t +t/rc_options.t t/testutil.pm t/unstow.t t/unstow_orig.t diff --git a/META.json b/META.json index 2a455a4..dd806c9 100644 --- a/META.json +++ b/META.json @@ -17,6 +17,7 @@ "build" : { "requires" : { "IO::Scalar" : "0", + "Hash::Merge": "0", "Test::More" : "0", "Test::Output" : "0" } diff --git a/META.yml b/META.yml index f94d472..9bcbadb 100644 --- a/META.yml +++ b/META.yml @@ -4,6 +4,7 @@ author: - unknown build_requires: IO::Scalar: '0' + Hash::Merge: '0' Test::More: '0' Test::Output: '0' configure_requires: diff --git a/NEWS b/NEWS index 3cc5562..3b676da 100644 --- a/NEWS +++ b/NEWS @@ -22,6 +22,16 @@ News file for Stow. Thanks to Joris Vankerschaver for this feature! +*** Shell-like expansion in .stowrc files + + For options within .stowrc files which describe file paths, "~" can + be included to expand to the current value of $HOME, and + environment variables can be referenced e.g. via "$FOO" or + "${FOO}". To prevent expansion, escape with a backslash. + + Thanks a lot to Charles LeDoux for his diligent work on this + feature! + *** chkstow now honours the $STOW_DIR environment variable The stow script already honoured the $STOW_DIR environment diff --git a/bin/stow.in b/bin/stow.in index d64c381..9afe2a1 100755 --- a/bin/stow.in +++ b/bin/stow.in @@ -343,6 +343,28 @@ 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 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 is maintained as a Texinfo manual. @@ -432,12 +454,14 @@ use warnings; require 5.006_001; use POSIX qw(getcwd); -use Getopt::Long; +use Getopt::Long qw(GetOptionsFromArray); @USE_LIB_PMDIR@ use Stow; use Stow::Util qw(parent error); +use Hash::Merge qw( merge ); + my $ProgramName = $0; $ProgramName =~ s{.*/}{}; @@ -481,23 +505,61 @@ sub main { #===== SUBROUTINE =========================================================== # Name : process_options() -# Purpose : parse command line 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 command line option is given +# 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. + # rc options come first in merged arrays. + # cli options overwrite conflicting rc options. + Hash::Merge::set_behavior('RIGHT_PRECEDENT'); + my $options = merge($rc_options, $cli_options); + + # 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'; - unshift @ARGV, get_config_file_options(); - #$,="\n"; print @ARGV,"\n"; # for debugging rc file + #$,="\n"; print @_,"\n"; # for debugging rc file Getopt::Long::config('no_ignore_case', 'bundling', 'permute'); - GetOptions( + GetOptionsFromArray( + \@_, \%options, 'verbose|v:+', 'help|h', 'simulate|n|no', 'version|V', 'compat|p', 'dir|d=s', 'target|t=s', @@ -548,12 +610,8 @@ sub process_options { usage() if $options{help}; version() if $options{version}; - sanitize_path_options(\%options); - check_packages(\@pkgs_to_unstow, \@pkgs_to_stow); - return (\%options, \@pkgs_to_unstow, \@pkgs_to_stow); } - sub sanitize_path_options { my ($options) = @_; @@ -589,22 +647,21 @@ sub check_packages { } } - #===== SUBROUTINE ============================================================ # Name : get_config_file_options() # Purpose : search for default settings in any .stowrc files # Parameters: none -# Returns : a list of default options -# Throws : no exceptions -# Comments : prepends the contents of '~/.stowrc' and '.stowrc' to the command -# : line so they get parsed just like normal arguments. (This was -# : hacked in so that Emil and I could set different preferences). +# 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 = (); for my $file ("$ENV{HOME}/.stowrc", '.stowrc') { if (-r $file) { - warn "Loading defaults from $file\n"; open my $FILE, '<', $file or die "Could not open $file for reading\n"; while (my $line = <$FILE>){ @@ -614,9 +671,102 @@ sub get_config_file_options { close $FILE or die "Could not close open file: $file\n"; } } - return @defaults; + + # 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/(? 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 @@ -629,7 +779,7 @@ sub usage { my ($msg) = @_; if ($msg) { - print "$ProgramName: $msg\n\n"; + warn "$ProgramName: $msg\n\n"; } print <<"EOT"; diff --git a/doc/stow.texi b/doc/stow.texi index 1042ad4..d4e4087 100644 --- a/doc/stow.texi +++ b/doc/stow.texi @@ -881,9 +881,10 @@ directory. Default command line options may be set in @file{.stowrc} (current directory) or @file{~/.stowrc} (home directory). These are parsed in -that order, and effectively prepended to the command line arguments -(with the notable difference that they won't be processed by the shell). -This feature can be used for some interesting effects. +that order, and are appended together if they both exist. The effect of +the options in the resource file is similar to simply prepending the +options to the command line. This feature can be used for some +interesting effects. For example, suppose your site uses more than one stow directory, perhaps in order to share around responsibilities with a number of systems @@ -922,6 +923,22 @@ immediate parent directory @file{/usr/local/stow}), overriding any pre-existing links to bin files or man pages, and ignoring some cruft that gets installed by default. +If an option is provided both on the command line and in a resource file, +the command line option takes precedence. For options that provide a single +value, such as @command{--target} or @command{--dir}, the command line +option will overwrite any options in the resource file. For options that can +be given more than once, @command{--ignore} for example, command line +options and resource options are appended together. + +For options that take a file path, environment variables and the tilde +character (@command{~}) are expanded. An environment variable can be +given in either the @command{$VAR} or @command{$@{VAR@}} form. To +prevent expansion, escape the @command{$} or @command{~} with a +backslash. + +The options @command{-D}, @command{-S}, and @command{-R} are ignored in +resource files. This is also true of any package names given in the +resource file. @c =========================================================================== @node Compile-time vs Install-time, Bootstrapping, Resource Files, Top diff --git a/t/cli_options.t b/t/cli_options.t index fafb6d8..0e99cd1 100755 --- a/t/cli_options.t +++ b/t/cli_options.t @@ -7,7 +7,7 @@ use strict; use warnings; -use Test::More tests => 9; +use Test::More tests => 10; use testutil; @@ -82,5 +82,16 @@ local @ARGV = ( ($options, $pkgs_to_delete, $pkgs_to_stow) = process_options(); is_deeply($options->{ignore}, [ qr(~\z), qr(\.#.*\z) ] => 'ignore temp files'); +# +# Check that expansion not applied. +# +local @ARGV = ( + "--target=$OUT_DIR/".'$HOME', + 'dummy' +); +make_dir("$OUT_DIR/".'$HOME'); +($options, $pkgs_to_delete, $pkgs_to_stow) = process_options(); +is($options->{target}, "$OUT_DIR/".'$HOME', 'no expansion'); +remove_dir("$OUT_DIR/".'$HOME'); # vim:ft=perl diff --git a/t/rc_options.t b/t/rc_options.t new file mode 100755 index 0000000..6905df5 --- /dev/null +++ b/t/rc_options.t @@ -0,0 +1,170 @@ +#!/usr/local/bin/perl + +# +# Test processing of stowrc file. +# + +use strict; +use warnings; + +use Test::More tests => 23; + +use testutil; + +require 'stow'; + +# stowrc file used for testing. +my $RC_FILE = "$OUT_DIR/.stowrc"; +# Take the safe route and cowardly refuse to continue if there's +# already a file at $RC_FILE. +if (-e $RC_FILE) { + die "RC file location $RC_FILE already exists!\n"; +} + +# Define the variable that will be used to write stowrc. +my $rc_contents; + +# Init testing directory structure and overwrite ENV{HOME} to prevent +# squashing existing stowrc file. +init_test_dirs(); + +# =========== RC Loading Tests =========== +# Basic parsing and loading rc file tests. +# ======================================== + +# +# Test stowrc file with one options per line. +# +local @ARGV = ('dummy'); +$rc_contents = <{target}, "$OUT_DIR/target", "rc options different lines"); +is($options->{dir}, "$OUT_DIR/stow", "rc options different lines"); + +# +# Test that scalar cli option overwrites conflicting stowrc option. +# +local @ARGV = ('-d', "$OUT_DIR/stow",'dummy'); +$rc_contents = <{dir}, "$OUT_DIR/stow", "cli overwrite scalar rc option."); + +# +# Test that list cli option merges with conflicting stowrc option. +# Documentation states that stowrc options are prepended to cli options. +# +local @ARGV = ( + '--defer=man', + 'dummy' +); +$rc_contents = <{defer}, [qr(\Ainfo), qr(\Aman)], + 'defer man and info'); + +# ======== Filepath Expansion Tests ======== +# Test proper filepath expansion in rc file. +# Expansion is only applied to options that +# take a filepath, namely target and dir. +# ========================================== + + +# +# Test environment variable expansion function. +# +# Basic expansion +is(expand_environment('$HOME/stow'), "$OUT_DIR/stow", 'expand $HOME'); +is(expand_environment('${HOME}/stow'), "$OUT_DIR/stow", 'expand ${HOME}'); + +delete $ENV{UNDEFINED}; # just in case +foreach my $var ('$UNDEFINED', '${UNDEFINED}') { + eval { + expand_environment($var, "--foo option"); + }; + is( + $@, + "--foo option references undefined environment variable \$UNDEFINED; " . + "aborting!\n", + "expand $var" + ); +} + +# Expansion with an underscore. +$ENV{'WITH_UNDERSCORE'} = 'test string'; +is(expand_environment('${WITH_UNDERSCORE}'), 'test string', + 'expand ${WITH_UNDERSCORE}'); +delete $ENV{'WITH_UNDERSCORE'}; +# Expansion with escaped $ +is(expand_environment('\$HOME/stow'), '$HOME/stow', 'expand \$HOME'); + +# +# Test tilde (~) expansion +# +# Basic expansion +is(expand_tilde('~/path'), "$ENV{HOME}/path", 'tilde expansion to $HOME'); +# Should not expand if middle of path +is(expand_tilde('/path/~/here'), '/path/~/here', 'middle ~ not expanded'); +# Test escaped ~ +is(expand_tilde('\~/path'), '~/path', 'escaped tilde'); + +# +# Test that environment variable expansion is applied. +# +$rc_contents = <<'HERE'; +--dir=$HOME/stow +--target=$HOME/stow +--ignore=\$HOME +--defer=\$HOME +--override=\$HOME +HERE +make_file($RC_FILE, $rc_contents); +($options, $pkgs_to_delete, $pkgs_to_stow) = get_config_file_options(); +is($options->{dir}, "$OUT_DIR/stow", + "apply environment expansion on stowrc --dir"); +is($options->{target}, "$OUT_DIR/stow", + "apply environment expansion on stowrc --target"); +is_deeply($options->{ignore}, [qr(\$HOME\z)], + "environment expansion not applied on --ignore"); +is_deeply($options->{defer}, [qr(\A\$HOME)], + "environment expansion not applied on --defer"); +is_deeply($options->{override}, [qr(\A\$HOME)], + "environment expansion not applied on --override"); + +# +# Test that tilde expansion is applied in correct places. +# +$rc_contents = <<'HERE'; +--dir=~/stow +--target=~/stow +--ignore=~/stow +--defer=~/stow +--override=~/stow +HERE +make_file($RC_FILE, $rc_contents); +($options, $pkgs_to_delete, $pkgs_to_stow) = get_config_file_options(); +is($options->{dir}, "$OUT_DIR/stow", + "apply environment expansion on stowrc --dir"); +is($options->{target}, "$OUT_DIR/stow", + "apply environment expansion on stowrc --target"); +is_deeply($options->{ignore}, [qr(~/stow\z)], + "environment expansion not applied on --ignore"); +is_deeply($options->{defer}, [qr(\A~/stow)], + "environment expansion not applied on --defer"); +is_deeply($options->{override}, [qr(\A~/stow)], + "environment expansion not applied on --override"); + +# Clean up files used for testing. +# +unlink $RC_FILE or die "Unable to clean up $RC_FILE.\n"; +remove_dir($OUT_DIR); + diff --git a/t/testutil.pm b/t/testutil.pm index 1e73dfe..a9d673f 100755 --- a/t/testutil.pm +++ b/t/testutil.pm @@ -55,7 +55,7 @@ sub init_test_dirs { } # Don't let user's ~/.stow-global-ignore affect test results - $ENV{HOME} = '/tmp/fake/home'; + $ENV{HOME} = $OUT_DIR; } sub new_Stow {