dot/stow
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Add support for .stow-rename file so files inside packages can have different names to their stowed versions

Browse source
This commit is contained in:
Danielle McLean 2016-10-07 23:10:00 +11:00
parent db7dcc0653
commit e08954e3a7
No known key found for this signature in database
GPG key ID: CC91589719027E94
1 changed files with 101 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

144
.local/share/perl/Stow.pm
View file

@ -48,6 +48,8 @@ our $VERSION = '2.2.2';
our $LOCAL_IGNORE_FILE = '.stow-local-ignore'; our $LOCAL_IGNORE_FILE = '.stow-local-ignore';
our $GLOBAL_IGNORE_FILE = '.stow-global-ignore'; our $GLOBAL_IGNORE_FILE = '.stow-global-ignore';
our $NO_FOLDING_FILE = '.stow-no-folding';
our $RENAME_FILE = '.stow-rename';
our @default_global_ignore_regexps = our @default_global_ignore_regexps =
__PACKAGE__->get_default_global_ignore_regexps(); __PACKAGE__->get_default_global_ignore_regexps();
@ -205,6 +207,9 @@ sub init_state {
# Store command line packages to unstow (-D and -R) # Store command line packages to unstow (-D and -R)
$self->{pkgs_to_delete} = []; $self->{pkgs_to_delete} = [];
# Store .stow-rename info indexed by package name.
$self->{pkg_renames} = {};
# The following structures are used by the abstractions that allow us to # The following structures are used by the abstractions that allow us to
# defer operating on the filesystem until after all potential conflicts have # defer operating on the filesystem until after all potential conflicts have
# been assessed. # been assessed.
@ -351,6 +356,10 @@ sub stow_contents {
my $self = shift; my $self = shift;
my ($stow_path, $package, $target, $source) = @_; my ($stow_path, $package, $target, $source) = @_;
$target = $source;
$target =~ s/^(\.\.\/)*\Q$stow_path\E\/\Q$package\E\/?//;
$target = '.' unless $target;
my $path = join_paths($stow_path, $package, $target); my $path = join_paths($stow_path, $package, $target);
return if $self->should_skip_target_which_is_stow_dir($target); return if $self->should_skip_target_which_is_stow_dir($target);
@ -361,10 +370,11 @@ sub stow_contents {
debug(3, $msg); debug(3, $msg);
debug(4, " => $source"); debug(4, " => $source");
my $dest = $self->renamed($package, $target);
error("stow_contents() called with non-directory path: $path") error("stow_contents() called with non-directory path: $path")
unless -d $path; unless -d $path;
error("stow_contents() called with non-directory target: $target") error("stow_contents() called with non-directory target: $dest")
unless $self->is_a_node($target); unless $self->is_a_node($dest);
opendir my $DIR, $path opendir my $DIR, $path
or error("cannot read directory: $path ($!)"); or error("cannot read directory: $path ($!)");
@ -424,13 +434,14 @@ sub stow_node {
} }
# Does the target already exist? # Does the target already exist?
if ($self->is_a_link($target)) { my $dest = $self->renamed($package, $target);
if ($self->is_a_link($dest)) {
# Where is the link pointing? # Where is the link pointing?
my $existing_source = $self->read_a_link($target); my $existing_source = $self->read_a_link($dest);
if (not $existing_source) { if (not $existing_source) {
error("Could not read link: $target"); error("Could not read link: $dest");
} }
debug(4, " Evaluate existing link: $target => $existing_source"); debug(4, " Evaluate existing link: $dest => $existing_source");
# Does it point to a node under any stow directory? # Does it point to a node under any stow directory?
my ($existing_path, $existing_stow_path, $existing_package) = my ($existing_path, $existing_stow_path, $existing_package) =
@ -439,7 +450,7 @@ sub stow_node {
$self->conflict( $self->conflict(
'stow', 'stow',
$package, $package,
"existing target is not owned by stow: $target" "existing target is not owned by stow: $dest"
); );
return; # XXX # return; # XXX #
} }
@ -457,16 +468,16 @@ sub stow_node {
$self->do_unlink($target); $self->do_unlink($target);
$self->do_link($source, $target); $self->do_link($source, $target);
} }
elsif ($self->is_a_dir(join_paths(parent($target), $existing_source)) && elsif ($self->is_a_dir(join_paths(parent($dest), $existing_source)) &&
$self->is_a_dir(join_paths(parent($target), $source)) ) { $self->is_a_dir(join_paths(parent($dest), $source)) ) {
# If the existing link points to a directory, # If the existing link points to a directory,
# and the proposed new link points to a directory, # and the proposed new link points to a directory,
# then we can unfold (split open) the tree at that point # then we can unfold (split open) the tree at that point
debug(2, "--- Unfolding $target which was already owned by $existing_package"); debug(2, "--- Unfolding $dest which was already owned by $existing_package");
$self->do_unlink($target); $self->do_unlink($dest);
$self->do_mkdir($target); $self->do_mkdir($dest);
$self->stow_contents( $self->stow_contents(
$existing_stow_path, $existing_stow_path,
$existing_package, $existing_package,
@ -485,20 +496,20 @@ sub stow_node {
'stow', 'stow',
$package, $package,
"existing target is stowed to a different package: " "existing target is stowed to a different package: "
. "$target => $existing_source" . "$dest => $existing_source"
); );
} }
} }
else { else {
# The existing link is invalid, so replace it with a good link # The existing link is invalid, so replace it with a good link
debug(2, "--- replacing invalid link: $path"); debug(2, "--- replacing invalid link: $dest");
$self->do_unlink($target); $self->do_unlink($dest);
$self->do_link($source, $target); $self->do_link($source, $dest);
} }
} }
elsif ($self->is_a_node($target)) { elsif ($self->is_a_node($dest)) {
debug(4, " Evaluate existing node: $target"); debug(4, " Evaluate existing node: $dest");
if ($self->is_a_dir($target)) { if ($self->is_a_dir($dest)) {
$self->stow_contents( $self->stow_contents(
$self->{stow_path}, $self->{stow_path},
$package, $package,
@ -508,20 +519,20 @@ sub stow_node {
} }
else { else {
if ($self->{adopt}) { if ($self->{adopt}) {
$self->do_mv($target, $path); $self->do_mv($dest, $path);
$self->do_link($source, $target); $self->do_link($source, $dest);
} }
else { else {
$self->conflict( $self->conflict(
'stow', 'stow',
$package, $package,
"existing target is neither a link nor a directory: $target" "existing target is neither a link nor a directory: $dest"
); );
} }
} }
} }
elsif ($self->{'no-folding'} && -d $path && ! -l $path) { elsif ($self->{'no-folding'} && -d $path && ! -l $path) {
$self->do_mkdir($target); $self->do_mkdir($dest);
$self->stow_contents( $self->stow_contents(
$self->{stow_path}, $self->{stow_path},
$package, $package,
@ -530,7 +541,7 @@ sub stow_node {
); );
} }
else { else {
$self->do_link($source, $target); $self->do_link($source, $dest);
} }
return; return;
} }
@ -716,6 +727,7 @@ sub unstow_contents {
my ($stow_path, $package, $target) = @_; my ($stow_path, $package, $target) = @_;
my $path = join_paths($stow_path, $package, $target); my $path = join_paths($stow_path, $package, $target);
my $dest = $self->renamed($package, $target);
return if $self->should_skip_target_which_is_stow_dir($target); return if $self->should_skip_target_which_is_stow_dir($target);
@ -730,8 +742,8 @@ sub unstow_contents {
# When called at the top level, $target should exist. And # When called at the top level, $target should exist. And
# unstow_node() should only call this via mutual recursion if # unstow_node() should only call this via mutual recursion if
# $target exists. # $target exists.
error("unstow_contents() called with invalid target: $target") error("unstow_contents() called with invalid target: $dest")
unless $self->is_a_node($target); unless $self->is_a_node($dest);
opendir my $DIR, $path opendir my $DIR, $path
or error("cannot read directory: $path ($!)"); or error("cannot read directory: $path ($!)");
@ -767,22 +779,23 @@ sub unstow_node {
my ($stow_path, $package, $target) = @_; my ($stow_path, $package, $target) = @_;
my $path = join_paths($stow_path, $package, $target); my $path = join_paths($stow_path, $package, $target);
my $dest = $self->renamed($package, $target);
debug(3, "Unstowing $path"); debug(3, "Unstowing $path");
debug(4, " target is $target"); debug(4, " target is $dest");
# Does the target exist? # Does the target exist?
if ($self->is_a_link($target)) { if ($self->is_a_link($dest)) {
debug(4, " Evaluate existing link: $target"); debug(4, " Evaluate existing link: $dest");
# Where is the link pointing? # Where is the link pointing?
my $existing_source = $self->read_a_link($target); my $existing_source = $self->read_a_link($dest);
if (not $existing_source) { if (not $existing_source) {
error("Could not read link: $target"); error("Could not read link: $dest");
} }
if ($existing_source =~ m{\A/}) { if ($existing_source =~ m{\A/}) {
warn "Ignoring an absolute symlink: $target => $existing_source\n"; warn "Ignoring an absolute symlink: $dest => $existing_source\n";
return; # XXX # return; # XXX #
} }
@ -793,7 +806,7 @@ sub unstow_node {
$self->conflict( $self->conflict(
'unstow', 'unstow',
$package, $package,
"existing target is not owned by stow: $target => $existing_source" "existing target is not owned by stow: $dest => $existing_source"
); );
return; # XXX # return; # XXX #
} }
@ -802,7 +815,7 @@ sub unstow_node {
if (-e $existing_path) { if (-e $existing_path) {
# Does link points to the right place? # Does link points to the right place?
if ($existing_path eq $path) { if ($existing_path eq $path) {
$self->do_unlink($target); $self->do_unlink($dest);
} }
# XXX we quietly ignore links that are stowed to a different # XXX we quietly ignore links that are stowed to a different
@ -825,30 +838,30 @@ sub unstow_node {
#} #}
} }
else { else {
debug(2, "--- removing invalid link into a stow directory: $path"); debug(2, "--- removing invalid link into a stow directory: $dest");
$self->do_unlink($target); $self->do_unlink($dest);
} }
} }
elsif (-e $target) { elsif (-e $dest) {
debug(4, " Evaluate existing node: $target"); debug(4, " Evaluate existing node: $dest");
if (-d $target) { if (-d $dest) {
$self->unstow_contents($stow_path, $package, $target); $self->unstow_contents($stow_path, $package, $target);
# This action may have made the parent directory foldable # This action may have made the parent directory foldable
if (my $parent = $self->foldable($target)) { if (my $parent = $self->foldable($dest)) {
$self->fold_tree($target, $parent); $self->fold_tree($dest, $parent);
} }
} }
else { else {
$self->conflict( $self->conflict(
'unstow', 'unstow',
$package, $package,
"existing target is neither a link nor a directory: $target", "existing target is neither a link nor a directory: $dest",
); );
} }
} }
else { else {
debug(2, "$target did not exist to be unstowed"); debug(2, "$dest did not exist to be unstowed");
} }
return; return;
} }
@ -1313,6 +1326,11 @@ sub get_ignore_regexps_from_fh {
# because this is the only place stow looks for them. # because this is the only place stow looks for them.
$regexps{"^/\Q$LOCAL_IGNORE_FILE\E\$"}++; $regexps{"^/\Q$LOCAL_IGNORE_FILE\E\$"}++;
# Also ignore the files .stow-no-folding and .stow-rename, for the same
# reason.
$regexps{"^/\Q$NO_FOLDING_FILE\E\$"}++;
$regexps{"^/\Q$RENAME_FILE\E\$"}++;
return $self->compile_ignore_regexps(%regexps); return $self->compile_ignore_regexps(%regexps);
} }
@ -1602,6 +1620,46 @@ sub is_a_link {
return 0; return 0;
} }
sub renamed {
my $self = shift;
my ($package, $path) = @_;
return $self->do_rename($self->read_rename_file($package), $path);
}
sub read_rename_file {
my $self = shift;
my ($package) = @_;
return $self->{pkg_renames}{$package} if defined $self->{pkg_renames}{$package};
my %renames = ();
$self->{pkg_renames}{$package} = \%renames;
my $file = join_paths($self->{stow_path}, $package, $RENAME_FILE);
return \%renames if (not -f $file);
open my $fh, $file or die "Could not open file $!";
while (<$fh>) {
chomp;
%renames = (%renames, split/\s*=>\s*/);
}
close $fh;
return \%renames;
}
sub do_rename {
my $self = shift;
my ($renames, $path) = @_;
my %renames = %{ $renames };
return $renames{$path} if $renames{$path};
foreach my $dir (keys %renames) {
if (0 == index $path, $dir) {
$path =~ s/^\Q$dir\E/$renames{$dir}/;
}
}
return $path;
}
#===== METHOD =============================================================== #===== METHOD ===============================================================
# Name : is_a_dir() # Name : is_a_dir()
# Purpose : determine if the given path is a current or planned directory # Purpose : determine if the given path is a current or planned directory