Use File::Spec->abs2rel() instead of home-grown relative_path
which actually gets some inputs wrong (e.g. "/" relative to "/")
This commit is contained in:
parent
8b5a0f5aa3
commit
801446a5eb
3 changed files with 2 additions and 76 deletions
|
@ -15,7 +15,6 @@ TESTS = \
|
|||
t/foldable.t \
|
||||
t/join_paths.t \
|
||||
t/parent.t \
|
||||
t/relative_path.t \
|
||||
t/stow_contents.t \
|
||||
t/stow.t \
|
||||
t/unstow_contents_orig.t \
|
||||
|
|
36
stow.in
36
stow.in
|
@ -24,6 +24,7 @@ use warnings;
|
|||
|
||||
require 5.6.1;
|
||||
|
||||
use File::Spec;
|
||||
use POSIX qw(getcwd);
|
||||
use Getopt::Long;
|
||||
|
||||
|
@ -380,7 +381,7 @@ sub set_stow_path {
|
|||
}
|
||||
|
||||
# set our one global
|
||||
$Stow_Path = relative_path(getcwd(),$stow_dir);
|
||||
$Stow_Path = File::Spec->abs2rel($stow_dir);
|
||||
|
||||
if ($Option{'verbose'} > 1) {
|
||||
warn "current dir is ".getcwd()."\n";
|
||||
|
@ -1665,39 +1666,6 @@ sub strip_quotes {
|
|||
return $string;
|
||||
}
|
||||
|
||||
#===== SUBROUTINE ===========================================================
|
||||
# Name : relative_path()
|
||||
# Purpose : find the relative path between two given paths
|
||||
# Parameters: path1 => a directory path
|
||||
# : path2 => a directory path
|
||||
# Returns : path2 relative to path1
|
||||
# Throws : n/a
|
||||
# Comments : only used once by main interactive routine
|
||||
# : factored out for testing
|
||||
#============================================================================
|
||||
sub relative_path {
|
||||
|
||||
my ($path1, $path2) = @_;
|
||||
|
||||
my (@path1) = split m{/+}, $path1;
|
||||
my (@path2) = split m{/+}, $path2;
|
||||
|
||||
# drop common prefixes until we find a difference
|
||||
PREFIX:
|
||||
while ( @path1 && @path2 ) {
|
||||
last PREFIX if $path1[0] ne $path2[0];
|
||||
shift @path1;
|
||||
shift @path2;
|
||||
}
|
||||
|
||||
# prepend one '..' to $path2 for each component of $path1
|
||||
while ( shift @path1 ) {
|
||||
unshift @path2, '..';
|
||||
}
|
||||
|
||||
return join_paths(@path2);
|
||||
}
|
||||
|
||||
#===== SUBROUTINE ===========================================================
|
||||
# Name : join_paths()
|
||||
# Purpose : concatenates given paths
|
||||
|
|
|
@ -1,41 +0,0 @@
|
|||
#!/usr/local/bin/perl
|
||||
|
||||
#
|
||||
# Testing relative_path();
|
||||
#
|
||||
|
||||
# load as a library
|
||||
BEGIN { use lib qw(. ..); require "stow"; }
|
||||
|
||||
use Test::More tests => 5;
|
||||
|
||||
is(
|
||||
relative_path('a/b/c', 'a/b/d'),
|
||||
'../d',
|
||||
=> 'different branches'
|
||||
);
|
||||
|
||||
is(
|
||||
relative_path('/a/b/c', '/a/b/c/d'),
|
||||
'd',
|
||||
=> 'lower same branch'
|
||||
);
|
||||
|
||||
is(
|
||||
relative_path('a/b/c', 'a/b'),
|
||||
'..',
|
||||
=> 'higher, same branch'
|
||||
);
|
||||
|
||||
is(
|
||||
relative_path('/a/b/c', '/d/e/f'),
|
||||
'../../../d/e/f',
|
||||
=> 'common parent is /'
|
||||
);
|
||||
|
||||
is(
|
||||
relative_path('///a//b//c////', '/a////b/c/d////'),
|
||||
'd',
|
||||
=> 'extra /\'s '
|
||||
);
|
||||
|
Loading…
Reference in a new issue