# Some shared sub routines
#
# Author: Patrick Canterino <patrick@patshaping.de>
-# Last modified: 2005-01-06
+# Last modified: 2005-02-12
#
use strict;
# We extract the last part of the path and create the absolute path
my $first = upper_path($path);
+ $first = abs_path($first);
+
my $last = file_name($path);
+ $last = '' if($last eq '.');
- $first = abs_path($first);
- $path = $first.'/'.$last;
+ if($last eq '..' || ($^O eq 'MSWin32' && $last =~ m!^\.\.\.+$!))
+ {
+ $first = abs_path($first.'/'.$last);
+ $last = '';
+ }
- $first = File::Spec->canonpath($first);
- $path = File::Spec->canonpath($path);
+ $path = File::Spec->canonpath($first.'/'.$last);
# Check if the path is above the root directory
return if(index($path,$root) != 0);
- return if($first eq $root && $last =~ m!^(/|\\)?\.\.(/|\\)?$!);
# Create short path name
my $short_path = substr($path,length($root));
$short_path =~ tr!\\!/!;
$short_path = '/'.$short_path if($short_path !~ m!^/!);
- $short_path = $short_path.'/' if($short_path !~ m!/$! && -d $path);
+ $short_path = $short_path.'/' if($short_path !~ m!/$! && -d $path && not -l $path);
return ($path,$short_path);
}
my $path = shift;
$path =~ tr!\\!/!;
- unless($path eq '/')
+ unless($path =~ m!^/+$! || ($^O eq 'MSWin32' && $path =~ m!^[a-z]:/+$!))
{
$path =~ s!/+$!!;
$path = substr($path,rindex($path,'/')+1);
# upper_path()
#
-# Cut away the last part of a path
+# Remove the last part of a path
+# (the resulting path contains a trailing slash)
#
# Params: Path
#
my $path = shift;
$path =~ tr!\\!/!;
- unless($path eq '/')
+ unless($path =~ m!^/+$! || ($^O eq 'MSWin32' && $path =~ m!^[a-z]:/+$!))
{
$path =~ s!/+$!!;
$path = substr($path,0,rindex($path,'/')+1);