Perform shell expansion on the contents of .stowrc (#40)

Perform shell expansion on the contents of .stowrc

10 files changed, 386 insertions, 24 deletions

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<Stow> searches for default command line options at F<.stowrc> (current
+directory) and F<~/.stowrc> (home directory) in that order. If both
+locations are present, the files are effectively appended together.
+
+The effect of options in the resource file is similar to simply prepending
+the options to the command line. For options that provide a single value,
+such as F<--target> or F<--dir>, the command line option will overwrite any
+options in the resource file. For options that can be given more than once,
+F<--ignore> for example, command line options and resource options are
+appended together.
+
+Environment variables and the tilde character (F<~>) will be expanded for
+options that take a file path.
+
+The options F<-D>, F<-R>, F<-S>, and any packages listed in the resource
+file are ignored.
+
+See the info manual for more information on how stow handles resource
+file.
+
 =head1 SEE ALSO
 
 The full documentation for F<stow> is maintained as a Texinfo manual.
@@ -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/(?<!\\)\$\{((?:\w|\s)+)\}/
+               _safe_expand_env_var($1, $source)
+              /ge;
+    $path =~ s/(?<!\\)\$(\w+)/
+               _safe_expand_env_var($1, $source)
+              /ge;
+    # Remove \$ escapes.
+    $path =~ s/\\\$/\$/g;
+    return $path;
+}
+
+sub _safe_expand_env_var {
+    my ($var, $source) = @_;
+    unless (exists $ENV{$var}) {
+        die "$source references undefined environment variable \$$var; " .
+            "aborting!\n";
+    }
+    return $ENV{$var};
 }
 
+#===== SUBROUTINE ============================================================
+# Name      : expand_tilde()
+# Purpose   : Expands tilde to user's home directory path.
+# Parameters: $path => string to perform expansion on.
+# Returns   : String with replacements performed.
+# Throws    : n/a
+# Comments  : http://docstore.mik.ua/orelly/perl4/cook/ch07_04.htm
+#=============================================================================
+sub expand_tilde {
+    my ($path) = @_;
+    # Replace tilde with home path.
+	$path =~ s{ ^ ~ ( [^/]* ) }
+                  { $1
+                    ? (getpwnam($1))[7]
+                    : ( $ENV{HOME} || $ENV{LOGDIR}
+                         || (getpwuid($<))[7]
+                      )
+    }ex;
+    # Replace espaced tilde with regular tilde.
+    $path =~ s/\\~/~/g;
+	return $path
+}
+
+
 #===== SUBROUTINE ===========================================================
 # Name      : usage()
 # Purpose   : print program usage message and exit
@@ -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 = <<HERE;
+    -d $OUT_DIR/stow
+    --target $OUT_DIR/target
+HERE
+make_file($RC_FILE, $rc_contents);
+my ($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
+is($options->{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 = <<HERE;
+    -d bad/path
+HERE
+make_file($RC_FILE, $rc_contents);
+($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
+is($options->{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 = <<HERE;
+    --defer=info
+HERE
+make_file($RC_FILE, $rc_contents);
+($options, $pkgs_to_delete, $pkgs_to_stow) = process_options();
+is_deeply($options->{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 {