Special processing for dotfiles

5 files changed, 171 insertions, 3 deletions

diff --git a/MANIFEST b/MANIFEST
index 8fc5729..056d512 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -36,6 +36,7 @@ t/chkstow.t
 t/cleanup_invalid_links.t
 t/cli_options.t
 t/defer.t
+t/dotfiles.t
 t/examples.t
 t/find_stowed_path.t
 t/foldable.t
diff --git a/bin/stow.in b/bin/stow.in
index ec83f59..6e5673f 100755
--- a/bin/stow.in
+++ b/bin/stow.in
@@ -214,6 +214,22 @@ stowed to another package.
 Force stowing files beginning with this Perl regex if the file is
 already stowed to another package.
 
+=item --dotfiles
+
+Enable special handling for "dotfiles" (files or folders whose name
+begins with a period) in the package directory. If this option is
+enabled, Stow will add a preprocessing step for each file or folder
+whose name begins with "dot-", and replace the "dot-" prefix in the
+name by a period (.). This is useful when Stow is used to manage
+collections of dotfiles, to avoid having a package directory full of
+hidden files.
+
+For example, suppose we have a package containing two files,
+F<stow/dot-bashrc> and F<stow/dot-emacs.d/init.el>. With this option,
+Stow will create symlinks from F<.bashrc> to F<stow/dot-bashrc> and
+from F<.emacs.d/init.el> to F<stow/dot-emacs.d/init.el>. Any other
+files, whose name does not begin with "dot-", will be processed as usual.
+
 =item -V
 
 =item --version
@@ -481,7 +497,7 @@ sub process_options {
         \%options,
         'verbose|v:+', 'help|h', 'simulate|n|no',
         'version|V', 'compat|p', 'dir|d=s', 'target|t=s',
-        'adopt', 'no-folding',
+        'adopt', 'no-folding', 'dotfiles',
 
         # clean and pre-compile any regex's at parse time
         'ignore=s' =>
diff --git a/lib/Stow.pm.in b/lib/Stow.pm.in
index 851bb86..2f66446 100755
--- a/lib/Stow.pm.in
+++ b/lib/Stow.pm.in
@@ -41,7 +41,7 @@ use File::Spec;
 use POSIX qw(getcwd);
 
 use Stow::Util qw(set_debug_level debug error set_test_mode
-                  join_paths restore_cwd canon_path parent);
+                  join_paths restore_cwd canon_path parent adjust_dotfile);
 
 our $ProgramName = 'stow';
 our $VERSION = '@VERSION@';
@@ -60,6 +60,7 @@ our %DEFAULT_OPTIONS = (
     paranoid     => 0,
     compat       => 0,
     test_mode    => 0,
+    dotfiles     => 0,
     adopt        => 0,
     'no-folding' => 0,
     ignore       => [],
@@ -377,6 +378,13 @@ sub stow_contents {
         next NODE if $node eq '..';
         my $node_target = join_paths($target, $node);
         next NODE if $self->ignore($stow_path, $package, $node_target);
+
+        if ($self->{dotfiles}) {
+            my $adj_node_target = adjust_dotfile($node_target);
+            debug(4, "  Adjusting: $node_target => $adj_node_target");
+            $node_target = $adj_node_target;
+        }
+
         $self->stow_node(
             $stow_path,
             $package,
@@ -744,6 +752,13 @@ sub unstow_contents {
         next NODE if $node eq '..';
         my $node_target = join_paths($target, $node);
         next NODE if $self->ignore($stow_path, $package, $node_target);
+
+        if ($self->{dotfiles}) {
+            my $adj_node_target = adjust_dotfile($node_target);
+            debug(4, "  Adjusting: $node_target => $adj_node_target");
+            $node_target = $adj_node_target;
+        }
+
         $self->unstow_node($stow_path, $package, $node_target);
     }
     if (-d $target) {
@@ -801,6 +816,12 @@ sub unstow_node {
         # Does the existing $target actually point to anything?
         if (-e $existing_path) {
             # Does link points to the right place?
+
+            # Adjust for dotfile if necessary.
+            if ($self->{dotfiles}) {
+                $existing_path = adjust_dotfile($existing_path);
+            }
+
             if ($existing_path eq $path) {
                 $self->do_unlink($target);
             }
diff --git a/lib/Stow/Util.pm.in b/lib/Stow/Util.pm.in
index b709e7e..451a143 100644
--- a/lib/Stow/Util.pm.in
+++ b/lib/Stow/Util.pm.in
@@ -22,7 +22,7 @@ use POSIX qw(getcwd);
 use base qw(Exporter);
 our @EXPORT_OK = qw(
     error debug set_debug_level set_test_mode
-    join_paths parent canon_path restore_cwd
+    join_paths parent canon_path restore_cwd adjust_dotfile
 );
 
 our $ProgramName = 'stow';
@@ -193,6 +193,20 @@ sub restore_cwd {
     chdir($prev) or error("Your current directory $prev seems to have vanished");
 }
 
+sub adjust_dotfile {
+    my ($target) = @_;
+
+    my @result = ();
+    for my $part (split m{/+}, $target) {
+        if (($part ne "dot-") && ($part ne "dot-.")) {
+            $part =~ s/^dot-/./;
+        }
+        push @result, $part;
+    }
+
+    return join '/', @result;
+}
+
 =head1 BUGS
 
 =head1 SEE ALSO
diff --git a/t/dotfiles.t b/t/dotfiles.t
new file mode 100644
index 0000000..e6fa69e
--- /dev/null
+++ b/t/dotfiles.t
@@ -0,0 +1,116 @@
+#!/usr/local/bin/perl
+
+#
+# Test case for dotfiles special processing
+#
+
+use strict;
+use warnings;
+
+use testutil;
+
+use Test::More tests => 6;
+use English qw(-no_match_vars);
+
+use testutil;
+
+init_test_dirs();
+cd("$OUT_DIR/target");
+
+my $stow;
+
+#
+# process a dotfile marked with 'dot' prefix
+#
+
+$stow = new_Stow(dir => '../stow', dotfiles => 1);
+
+make_dir('../stow/dotfiles');
+make_file('../stow/dotfiles/dot-foo');
+
+$stow->plan_stow('dotfiles');
+$stow->process_tasks();
+is(
+    readlink('.foo'),
+    '../stow/dotfiles/dot-foo',
+    => 'processed dotfile'
+);
+
+#
+# ensure that turning off dotfile processing links files as usual
+#
+
+$stow = new_Stow(dir => '../stow', dotfiles => 0);
+
+make_dir('../stow/dotfiles');
+make_file('../stow/dotfiles/dot-foo');
+
+$stow->plan_stow('dotfiles');
+$stow->process_tasks();
+is(
+    readlink('dot-foo'),
+    '../stow/dotfiles/dot-foo',
+    => 'unprocessed dotfile'
+);
+
+
+#
+# process folder marked with 'dot' prefix
+#
+
+$stow = new_Stow(dir => '../stow', dotfiles => 1);
+
+make_dir('../stow/dotfiles/dot-emacs');
+make_file('../stow/dotfiles/dot-emacs/init.el');
+
+$stow->plan_stow('dotfiles');
+$stow->process_tasks();
+is(
+    readlink('.emacs'),
+    '../stow/dotfiles/dot-emacs',
+    => 'processed dotfile folder'
+);
+
+#
+# corner case: paths that have a part in them that's just "$DOT_PREFIX" or
+# "$DOT_PREFIX." should not have that part expanded.
+#
+
+$stow = new_Stow(dir => '../stow', dotfiles => 1);
+
+make_dir('../stow/dotfiles');
+make_file('../stow/dotfiles/dot-');
+
+make_dir('../stow/dotfiles/dot-.');
+make_file('../stow/dotfiles/dot-./foo');
+
+$stow->plan_stow('dotfiles');
+$stow->process_tasks();
+is(
+    readlink('dot-'),
+    '../stow/dotfiles/dot-',
+    => 'processed dotfile'
+);
+is(
+    readlink('dot-.'),
+    '../stow/dotfiles/dot-.',
+    => 'unprocessed dotfile'
+);
+
+#
+# simple unstow scenario
+#
+
+$stow = new_Stow(dir => '../stow', dotfiles => 1);
+
+make_dir('../stow/dotfiles');
+make_file('../stow/dotfiles/dot-bar');
+make_link('.bar', '../stow/dotfiles/dot-bar');
+
+$stow->plan_unstow('dotfiles');
+$stow->process_tasks();
+ok(
+    $stow->get_conflict_count == 0 &&
+    -f '../stow/dotfiles/dot-bar' && ! -e '.bar'
+    => 'unstow a simple dotfile'
+);