Add support for .stow-rename file so files inside packages can have different names to their stowed versions
This commit is contained in:
parent
db7dcc0653
commit
e08954e3a7
1 changed files with 101 additions and 43 deletions
|
@ -48,6 +48,8 @@ our $VERSION = '2.2.2';
|
|||
|
||||
our $LOCAL_IGNORE_FILE = '.stow-local-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 =
|
||||
__PACKAGE__->get_default_global_ignore_regexps();
|
||||
|
@ -205,6 +207,9 @@ sub init_state {
|
|||
# Store command line packages to unstow (-D and -R)
|
||||
$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
|
||||
# defer operating on the filesystem until after all potential conflicts have
|
||||
# been assessed.
|
||||
|
@ -351,6 +356,10 @@ sub stow_contents {
|
|||
my $self = shift;
|
||||
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);
|
||||
|
||||
return if $self->should_skip_target_which_is_stow_dir($target);
|
||||
|
@ -361,10 +370,11 @@ sub stow_contents {
|
|||
debug(3, $msg);
|
||||
debug(4, " => $source");
|
||||
|
||||
my $dest = $self->renamed($package, $target);
|
||||
error("stow_contents() called with non-directory path: $path")
|
||||
unless -d $path;
|
||||
error("stow_contents() called with non-directory target: $target")
|
||||
unless $self->is_a_node($target);
|
||||
error("stow_contents() called with non-directory target: $dest")
|
||||
unless $self->is_a_node($dest);
|
||||
|
||||
opendir my $DIR, $path
|
||||
or error("cannot read directory: $path ($!)");
|
||||
|
@ -424,13 +434,14 @@ sub stow_node {
|
|||
}
|
||||
|
||||
# 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?
|
||||
my $existing_source = $self->read_a_link($target);
|
||||
my $existing_source = $self->read_a_link($dest);
|
||||
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?
|
||||
my ($existing_path, $existing_stow_path, $existing_package) =
|
||||
|
@ -439,7 +450,7 @@ sub stow_node {
|
|||
$self->conflict(
|
||||
'stow',
|
||||
$package,
|
||||
"existing target is not owned by stow: $target"
|
||||
"existing target is not owned by stow: $dest"
|
||||
);
|
||||
return; # XXX #
|
||||
}
|
||||
|
@ -457,16 +468,16 @@ sub stow_node {
|
|||
$self->do_unlink($target);
|
||||
$self->do_link($source, $target);
|
||||
}
|
||||
elsif ($self->is_a_dir(join_paths(parent($target), $existing_source)) &&
|
||||
$self->is_a_dir(join_paths(parent($target), $source)) ) {
|
||||
elsif ($self->is_a_dir(join_paths(parent($dest), $existing_source)) &&
|
||||
$self->is_a_dir(join_paths(parent($dest), $source)) ) {
|
||||
|
||||
# If the existing 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
|
||||
|
||||
debug(2, "--- Unfolding $target which was already owned by $existing_package");
|
||||
$self->do_unlink($target);
|
||||
$self->do_mkdir($target);
|
||||
debug(2, "--- Unfolding $dest which was already owned by $existing_package");
|
||||
$self->do_unlink($dest);
|
||||
$self->do_mkdir($dest);
|
||||
$self->stow_contents(
|
||||
$existing_stow_path,
|
||||
$existing_package,
|
||||
|
@ -485,20 +496,20 @@ sub stow_node {
|
|||
'stow',
|
||||
$package,
|
||||
"existing target is stowed to a different package: "
|
||||
. "$target => $existing_source"
|
||||
. "$dest => $existing_source"
|
||||
);
|
||||
}
|
||||
}
|
||||
else {
|
||||
# The existing link is invalid, so replace it with a good link
|
||||
debug(2, "--- replacing invalid link: $path");
|
||||
$self->do_unlink($target);
|
||||
$self->do_link($source, $target);
|
||||
debug(2, "--- replacing invalid link: $dest");
|
||||
$self->do_unlink($dest);
|
||||
$self->do_link($source, $dest);
|
||||
}
|
||||
}
|
||||
elsif ($self->is_a_node($target)) {
|
||||
debug(4, " Evaluate existing node: $target");
|
||||
if ($self->is_a_dir($target)) {
|
||||
elsif ($self->is_a_node($dest)) {
|
||||
debug(4, " Evaluate existing node: $dest");
|
||||
if ($self->is_a_dir($dest)) {
|
||||
$self->stow_contents(
|
||||
$self->{stow_path},
|
||||
$package,
|
||||
|
@ -508,20 +519,20 @@ sub stow_node {
|
|||
}
|
||||
else {
|
||||
if ($self->{adopt}) {
|
||||
$self->do_mv($target, $path);
|
||||
$self->do_link($source, $target);
|
||||
$self->do_mv($dest, $path);
|
||||
$self->do_link($source, $dest);
|
||||
}
|
||||
else {
|
||||
$self->conflict(
|
||||
'stow',
|
||||
$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) {
|
||||
$self->do_mkdir($target);
|
||||
$self->do_mkdir($dest);
|
||||
$self->stow_contents(
|
||||
$self->{stow_path},
|
||||
$package,
|
||||
|
@ -530,7 +541,7 @@ sub stow_node {
|
|||
);
|
||||
}
|
||||
else {
|
||||
$self->do_link($source, $target);
|
||||
$self->do_link($source, $dest);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
@ -716,6 +727,7 @@ sub unstow_contents {
|
|||
my ($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);
|
||||
|
||||
|
@ -730,8 +742,8 @@ sub unstow_contents {
|
|||
# When called at the top level, $target should exist. And
|
||||
# unstow_node() should only call this via mutual recursion if
|
||||
# $target exists.
|
||||
error("unstow_contents() called with invalid target: $target")
|
||||
unless $self->is_a_node($target);
|
||||
error("unstow_contents() called with invalid target: $dest")
|
||||
unless $self->is_a_node($dest);
|
||||
|
||||
opendir my $DIR, $path
|
||||
or error("cannot read directory: $path ($!)");
|
||||
|
@ -767,22 +779,23 @@ sub unstow_node {
|
|||
my ($stow_path, $package, $target) = @_;
|
||||
|
||||
my $path = join_paths($stow_path, $package, $target);
|
||||
my $dest = $self->renamed($package, $target);
|
||||
|
||||
debug(3, "Unstowing $path");
|
||||
debug(4, " target is $target");
|
||||
debug(4, " target is $dest");
|
||||
|
||||
# Does the target exist?
|
||||
if ($self->is_a_link($target)) {
|
||||
debug(4, " Evaluate existing link: $target");
|
||||
if ($self->is_a_link($dest)) {
|
||||
debug(4, " Evaluate existing link: $dest");
|
||||
|
||||
# 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) {
|
||||
error("Could not read link: $target");
|
||||
error("Could not read link: $dest");
|
||||
}
|
||||
|
||||
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 #
|
||||
}
|
||||
|
||||
|
@ -793,7 +806,7 @@ sub unstow_node {
|
|||
$self->conflict(
|
||||
'unstow',
|
||||
$package,
|
||||
"existing target is not owned by stow: $target => $existing_source"
|
||||
"existing target is not owned by stow: $dest => $existing_source"
|
||||
);
|
||||
return; # XXX #
|
||||
}
|
||||
|
@ -802,7 +815,7 @@ sub unstow_node {
|
|||
if (-e $existing_path) {
|
||||
# Does link points to the right place?
|
||||
if ($existing_path eq $path) {
|
||||
$self->do_unlink($target);
|
||||
$self->do_unlink($dest);
|
||||
}
|
||||
|
||||
# XXX we quietly ignore links that are stowed to a different
|
||||
|
@ -825,30 +838,30 @@ sub unstow_node {
|
|||
#}
|
||||
}
|
||||
else {
|
||||
debug(2, "--- removing invalid link into a stow directory: $path");
|
||||
$self->do_unlink($target);
|
||||
debug(2, "--- removing invalid link into a stow directory: $dest");
|
||||
$self->do_unlink($dest);
|
||||
}
|
||||
}
|
||||
elsif (-e $target) {
|
||||
debug(4, " Evaluate existing node: $target");
|
||||
if (-d $target) {
|
||||
elsif (-e $dest) {
|
||||
debug(4, " Evaluate existing node: $dest");
|
||||
if (-d $dest) {
|
||||
$self->unstow_contents($stow_path, $package, $target);
|
||||
|
||||
# This action may have made the parent directory foldable
|
||||
if (my $parent = $self->foldable($target)) {
|
||||
$self->fold_tree($target, $parent);
|
||||
if (my $parent = $self->foldable($dest)) {
|
||||
$self->fold_tree($dest, $parent);
|
||||
}
|
||||
}
|
||||
else {
|
||||
$self->conflict(
|
||||
'unstow',
|
||||
$package,
|
||||
"existing target is neither a link nor a directory: $target",
|
||||
"existing target is neither a link nor a directory: $dest",
|
||||
);
|
||||
}
|
||||
}
|
||||
else {
|
||||
debug(2, "$target did not exist to be unstowed");
|
||||
debug(2, "$dest did not exist to be unstowed");
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
@ -1313,6 +1326,11 @@ sub get_ignore_regexps_from_fh {
|
|||
# because this is the only place stow looks for them.
|
||||
$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);
|
||||
}
|
||||
|
||||
|
@ -1602,6 +1620,46 @@ sub is_a_link {
|
|||
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 ===============================================================
|
||||
# Name : is_a_dir()
|
||||
# Purpose : determine if the given path is a current or planned directory
|
||||
|
|
Loading…
Reference in a new issue