Rewrite. abs_path() fails if path components before the last don't exist.

This commit is contained in:
Andrew Johnson
2008-01-11 21:35:56 +00:00
parent f26de14718
commit 5478ba8bc6

View File

@@ -1,20 +1,40 @@
eval 'exec perl -S -w $0 ${1+"$@"}' # -*- Mode: perl -*-
if 0;
if 0;
#
# Determine fullpathname if argument starts with "."
# else return argument value.
#
# Determines an absolute pathname for its argument,
# which may be either a relative or absolute path and
# might have trailing parts that don't exist yet.
use Cwd 'abs_path';
my $dir;
if( $ARGV[0] ) {
if( $ARGV[0] =~ /^\./ )
{
$dir = abs_path("$ARGV[0]");
$dir =~ s/\/tmp_mnt//;
print "$dir\n";
} else {
print "$ARGV[0]\n";
}
use strict;
use Cwd qw(getcwd abs_path);
use File::Spec;
# Starting values
my $cwd = getcwd();
my $rel = shift;
$rel = '.' unless defined $rel;
# Move leading ./ and ../ components from $rel to $cwd
if (my ($dot, $not) = ($rel =~ m[^ ( (?: \. \.? / )+ ) ( .* ) $]x)) {
$cwd .= "/$dot";
$rel = $not;
}
# Handle a pure ..
if ($rel eq '..') {
$cwd .= '/..';
$rel = '.'
}
# NB: abs_path() doesn't like non-existent path components other than
# in the final position, which is why we use this method.
# Calculate the absolute path
my $abs = File::Spec->rel2abs($rel, abs_path($cwd));
# Remove any automounter prefixes
$abs =~ s[^ /tmp_mnt ][]x; # SunOS, HPUX
$abs =~ s[^ /private/var/auto\. ][/]x; # MacOS
print "$abs\n";