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 and F. With this option, +Stow will create symlinks from F<.bashrc> to F and +from F<.emacs.d/init.el> to F. 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 633d584..e190c6c 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' +);