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

Stow.pm: rename $ldest to $link_dest for clarity

Browse source
This commit is contained in:
Adam Spiers 2024-03-31 15:38:38 +01:00
parent 1be40c0532
commit f4f3836c5f
2 changed files with 25 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
lib/Stow.pm.in
View file

@ -953,7 +953,8 @@ sub link_owned_by_package {
# : the target directory, relative to the # : the target directory, relative to the
# : top-level target directory (which is also # : top-level target directory (which is also
# : expected to be the current directory). # : expected to be the current directory).
# : $ldest => where that link points to (needed because link # :
# : $link_dest => where that link points to (needed because link
# : might not exist yet due to two-phase approach, # : might not exist yet due to two-phase approach,
# : so we can't just call readlink()). If this is # : so we can't just call readlink()). If this is
# : owned by Stow, it will be expressed relative to # : owned by Stow, it will be expressed relative to
@ -964,7 +965,7 @@ sub link_owned_by_package {
# Returns : ($path, $stow_path, $package) where $path and $stow_path # Returns : ($path, $stow_path, $package) where $path and $stow_path
# : are relative from the top-level target directory. $path # : are relative from the top-level target directory. $path
# : is the full relative path to the member of the package # : is the full relative path to the member of the package
# : pointed to by $ldest; $stow_path is the relative path # : pointed to by $link_dest; $stow_path is the relative path
# : to the stow directory; and $package is the name of the # : to the stow directory; and $package is the name of the
# : package; or ('', '', '') if link is not owned by stow. # : package; or ('', '', '') if link is not owned by stow.
# Throws : n/a # Throws : n/a
@ -975,9 +976,9 @@ sub link_owned_by_package {
# ============================================================================ # ============================================================================
sub find_stowed_path { sub find_stowed_path {
my $self = shift; my $self = shift;
my ($target, $ldest) = @_; my ($target, $link_dest) = @_;
if (substr($ldest, 0, 1) eq '/') { if (substr($link_dest, 0, 1) eq '/') {
# Symlink points to an absolute path, therefore it cannot be # Symlink points to an absolute path, therefore it cannot be
# owned by Stow. # owned by Stow.
return ('', '', ''); return ('', '', '');
@ -986,8 +987,8 @@ sub find_stowed_path {
# Evaluate softlink relative to its target, without relying on # Evaluate softlink relative to its target, without relying on
# what's actually on the filesystem, since the link might not # what's actually on the filesystem, since the link might not
# exist yet. # exist yet.
debug(4, 2, "find_stowed_path(target=$target; source=$ldest)"); debug(4, 2, "find_stowed_path(target=$target; source=$link_dest)");
my $dest = join_paths(parent($target), $ldest); my $dest = join_paths(parent($target), $link_dest);
debug(4, 3, "is symlink destination $dest owned by stow?"); debug(4, 3, "is symlink destination $dest owned by stow?");
# First check whether the link is owned by the current stow # First check whether the link is owned by the current stow
@ -1012,24 +1013,24 @@ sub find_stowed_path {
# ===== METHOD ================================================================ # ===== METHOD ================================================================
# Name : link_dest_within_stow_dir # Name : link_dest_within_stow_dir
# Purpose : detect whether symlink destination is within current stow dir # Purpose : detect whether symlink destination is within current stow dir
# Parameters: $ldest - destination of the symlink relative # Parameters: $link_dest - destination of the symlink relative
# Returns : ($package, $path) - package within the current stow dir # Returns : ($package, $path) - package within the current stow dir
# : and subpath within that package which the symlink points to # : and subpath within that package which the symlink points to
# ============================================================================= # =============================================================================
sub link_dest_within_stow_dir { sub link_dest_within_stow_dir {
my $self = shift; my $self = shift;
my ($ldest) = @_; my ($link_dest) = @_;
debug(4, 4, "common prefix? ldest=$ldest; stow_path=$self->{stow_path}"); debug(4, 4, "common prefix? link_dest=$link_dest; stow_path=$self->{stow_path}");
my $removed = $ldest =~ s,^\Q$self->{stow_path}/,,; my $removed = $link_dest =~ s,^\Q$self->{stow_path}/,,;
if (! $removed) { if (! $removed) {
debug(4, 3, "no - $ldest not under $self->{stow_path}"); debug(4, 3, "no - $link_dest not under $self->{stow_path}");
return ('', ''); return ('', '');
} }
debug(4, 4, "remaining after removing $self->{stow_path}: $ldest"); debug(4, 4, "remaining after removing $self->{stow_path}: $link_dest");
my @dirs = File::Spec->splitdir($ldest); my @dirs = File::Spec->splitdir($link_dest);
my $package = shift @dirs; my $package = shift @dirs;
my $path = File::Spec->catdir(@dirs); my $path = File::Spec->catdir(@dirs);
return ($package, $path); return ($package, $path);
@ -1127,30 +1128,30 @@ sub cleanup_invalid_links {
# Where is the link pointing? # Where is the link pointing?
# (don't use read_a_link() here) # (don't use read_a_link() here)
my $ldest = readlink($node_path); my $link_dest = readlink($node_path);
if (not $ldest) { if (not $link_dest) {
error("Could not read link $node_path"); error("Could not read link $node_path");
} }
my $target = join_paths($dir, $ldest); my $target = join_paths($dir, $link_dest);
debug(4, 2, "join $dir $ldest"); debug(4, 2, "join $dir $link_dest");
if (-e $target) { if (-e $target) {
debug(4, 2, "Link target $ldest exists at $target; skipping clean up"); debug(4, 2, "Link target $link_dest exists at $target; skipping clean up");
next; next;
} }
else { else {
debug(4, 2, "Link target $ldest doesn't exist at $target"); debug(4, 2, "Link target $link_dest doesn't exist at $target");
} }
debug(3, 1, debug(3, 1,
"Checking whether valid link $node_path -> $ldest is " . "Checking whether valid link $node_path -> $link_dest is " .
"owned by stow"); "owned by stow");
my $owner = $self->link_owned_by_package($node_path, $ldest); my $owner = $self->link_owned_by_package($node_path, $link_dest);
if ($owner) { if ($owner) {
# owned by stow # owned by stow
debug(2, 0, "--- removing link owned by $owner: $node_path => " . debug(2, 0, "--- removing link owned by $owner: $node_path => " .
join_paths($dir, $ldest)); join_paths($dir, $link_dest));
$self->do_unlink($node_path); $self->do_unlink($node_path);
} }
} }

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

@ -239,10 +239,10 @@ sub restore_cwd {
} }
sub adjust_dotfile { sub adjust_dotfile {
my ($target) = @_; my ($link_dest) = @_;
my @result = (); my @result = ();
for my $part (split m{/+}, $target) { for my $part (split m{/+}, $link_dest) {
if (($part ne "dot-") && ($part ne "dot-.")) { if (($part ne "dot-") && ($part ne "dot-.")) {
$part =~ s/^dot-/./; $part =~ s/^dot-/./;
} }