00dani/stow
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Merge pull request #17 from jvkersch/enh/dot-files

Browse source 
Special processing for dotfiles
This commit is contained in:
Adam Spiers 2016-10-05 17:47:51 +01:00 • committed by GitHub
commit 1b320b1dc3
5 changed files with 171 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

23
lib/Stow.pm.in
View file

@ -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);
}

16
lib/Stow/Util.pm.in
View file

@ -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