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:
Adam Spiers 2011-11-16 15:57:17 +00:00
parent 8b5a0f5aa3
commit 801446a5eb
3 changed files with 2 additions and 76 deletions

View file

@ -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
View file

@ -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

View file

@ -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 '
);