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/foldable.t \
|
||||||
t/join_paths.t \
|
t/join_paths.t \
|
||||||
t/parent.t \
|
t/parent.t \
|
||||||
t/relative_path.t \
|
|
||||||
t/stow_contents.t \
|
t/stow_contents.t \
|
||||||
t/stow.t \
|
t/stow.t \
|
||||||
t/unstow_contents_orig.t \
|
t/unstow_contents_orig.t \
|
||||||
|
|
36
stow.in
36
stow.in
|
@ -24,6 +24,7 @@ use warnings;
|
||||||
|
|
||||||
require 5.6.1;
|
require 5.6.1;
|
||||||
|
|
||||||
|
use File::Spec;
|
||||||
use POSIX qw(getcwd);
|
use POSIX qw(getcwd);
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
|
|
||||||
|
@ -380,7 +381,7 @@ sub set_stow_path {
|
||||||
}
|
}
|
||||||
|
|
||||||
# set our one global
|
# set our one global
|
||||||
$Stow_Path = relative_path(getcwd(),$stow_dir);
|
$Stow_Path = File::Spec->abs2rel($stow_dir);
|
||||||
|
|
||||||
if ($Option{'verbose'} > 1) {
|
if ($Option{'verbose'} > 1) {
|
||||||
warn "current dir is ".getcwd()."\n";
|
warn "current dir is ".getcwd()."\n";
|
||||||
|
@ -1665,39 +1666,6 @@ sub strip_quotes {
|
||||||
return $string;
|
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 ===========================================================
|
#===== SUBROUTINE ===========================================================
|
||||||
# Name : join_paths()
|
# Name : join_paths()
|
||||||
# Purpose : concatenates given 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