###########################################################################
# This Perl package helps with path transforming when running curl tests on
-# Windows platform with MSYS or Cygwin.
-# Three main functions 'sys_native_abs_path', 'sys_native_path' and
-# 'build_sys_abs_path' autodetect format of given pathnames. Following formats
-# are supported:
-# (1) /some/path - absolute path in Unix-style
+# native Windows and MSYS/Cygwin.
+# Following input formats are supported (via built-in Perl functions):
+# (1) /some/path - absolute path in POSIX-style
# (2) D:/some/path - absolute path in Windows-style
# (3) some/path - relative path
# (4) D:some/path - path relative to current directory on Windows drive
# slash in forms (1) and (5).
# Forward slashes are simpler processed in Perl, do not require extra escaping
# for shell (unlike back slashes) and accepted by Windows native programs, so
-# all functions return paths with only forward slashes except
-# 'sys_native_path' which returns paths with first forward slash for form (5).
+# all functions return paths with only forward slashes.
# All returned paths don't contain any duplicated slashes, only single slashes
# are used as directory separators on output.
# On non-Windows platforms functions acts as transparent wrappers for similar
sys_native_abs_path
sys_native_current_path
build_sys_abs_path
- normalize_path
- should_use_cygpath
- drives_mounted_on_cygdrive
);
}
}
}
-my $dev_null = ($^O eq 'MSWin32' ? 'NUL' : '/dev/null');
-
-my $use_cygpath; # Only for Windows:
- # undef - autodetect
- # 0 - do not use cygpath
- # 1 - use cygpath
-
-# Returns boolean true if 'cygpath' utility should be used for path conversion.
-sub should_use_cygpath {
- return $use_cygpath if defined $use_cygpath;
- if(os_is_win()) {
- $use_cygpath = (qx{cygpath -u '.\\' 2>$dev_null} eq "./\n" && $? == 0);
- } else {
- $use_cygpath = 0;
- }
- return $use_cygpath;
-}
-
-#######################################################################
-# Performs path "normalization": all slashes converted to forward
-# slashes (except leading slash), all duplicated slashes are replaced
-# with single slashes, all relative directories ('./' and '../') are
-# resolved if possible.
-# Path processed as string, directories are not checked for presence so
-# path for not yet existing directory can be "normalized".
-#
-sub normalize_path;
-
#######################################################################
# Returns current working directory in Windows format on Windows.
#
return Cwd::getcwd() if !os_is_win();
my $cur_dir;
- if($^O eq 'msys') {
- # MSYS shell has built-in command.
- chomp($cur_dir = `bash -c 'pwd -W'`);
- if($? != 0) {
- warn "Can't determine Windows current directory.\n";
- return undef;
- }
- # Add final slash if required.
- $cur_dir .= '/' if length($cur_dir) > 3;
+ if($^O eq 'MSWin32') {
+ $cur_dir = Cwd::getcwd();
}
else {
- # Do not use 'cygpath' - it falsely succeed on paths like '/cygdrive'.
- $cur_dir = `cmd "/c;" echo %__CD__%`;
- if($? != 0 || substr($cur_dir, 0, 1) eq '%') {
- warn "Can't determine Windows current directory.\n";
- return undef;
- }
- # Remove both '\r' and '\n'.
- $cur_dir =~ s{\n|\r}{}g;
-
- # Replace back slashes with forward slashes.
- $cur_dir =~ s{\\}{/}g;
+ $cur_dir = Cygwin::posix_to_win_path(Cwd::getcwd());
}
+ $cur_dir =~ s{[/\\]+}{/}g;
return $cur_dir;
}
-#######################################################################
-# Returns Windows current drive letter with colon.
-#
-sub get_win32_current_drive {
- # Notice parameter "/c;" - it's required to turn off MSYS's
- # transformation of '/c' and compatible with Cygwin.
- my $drive_letter = `cmd "/c;" echo %__CD__:~0,2%`;
- if($? != 0 || substr($drive_letter, 1, 1) ne ':') {
- warn "Can't determine current Windows drive letter.\n";
- return undef;
- }
-
- return substr($drive_letter, 0, 2);
-}
-
-# Internal function. Converts path by using MSYS's built-in transformation.
-# Returned path may contain duplicated and back slashes.
-sub do_msys_transform;
-
-# Internal function. Gets two parameters: first parameter must be single
-# drive letter ('c'), second optional parameter is path relative to drive's
-# current working directory. Returns Windows absolute normalized path.
-sub get_abs_path_on_win32_drive;
-
-# Internal function. Tries to find or guess Windows version of given
-# absolute Unix-style path. Other types of paths are not supported.
-# Returned paths contain only single forward slashes (no back and
-# duplicated slashes).
-# Last resort. Used only when other transformations are not available.
-sub do_dumb_guessed_transform;
-
-#######################################################################
-# Converts given path to system native format, i.e. to Windows format on
-# Windows platform. Relative paths converted to relative, absolute
-# paths converted to absolute.
-#
-sub sys_native_path {
- my ($path) = @_;
-
- # Return untouched on non-Windows platforms.
- return $path if (!os_is_win());
-
- # Do not process empty path.
- return $path if ($path eq '');
-
- if($path =~ s{^([a-zA-Z]):$}{\u$1:}) {
- # Path is single drive with colon. (C:)
- # This type of paths is not processed correctly by 'cygpath'.
- # WARNING!
- # Be careful, this relative path can be accidentally transformed
- # into wrong absolute path by adding to it some '/dirname' with
- # slash at font.
- return $path;
- }
- elsif($path =~ m{^\\} || $path =~ m{^[a-zA-Z]:[^/\\]}) {
- # Path is a directory or filename on Windows current drive or relative
- # path on current directory on specific Windows drive.
- # ('\path' or 'D:path')
- # First type of paths is not processed by MSYS transformation and
- # resolved to absolute path by 'cygpath'.
- # Second type is not processed by MSYS transformation and may be
- # incorrectly processed by 'cygpath' (for paths like 'D:..\../.\')
-
- my $first_char = ucfirst(substr($path, 0, 1));
-
- # Replace any back and duplicated slashes with single forward slashes.
- $path =~ s{[\\/]+}{/}g;
-
- # Convert leading slash back to forward slash to indicate
- # directory on Windows current drive or capitalize drive letter.
- substr($path, 0, 1, $first_char);
- return $path;
- }
- elsif(should_use_cygpath()) {
- # 'cygpath' is available - use it.
-
- # Remove leading duplicated forward and back slashes, as they may
- # prevent transforming and may be not processed.
- $path =~ s{^([\\/])[\\/]+}{$1}g;
-
- my $has_final_slash = ($path =~ m{[/\\]$});
-
- # Use 'cygpath', '-m' means Windows path with forward slashes.
- chomp($path = `cygpath -m '$path'`);
- if ($? != 0) {
- warn "Can't convert path by \"cygpath\".\n";
- return undef;
- }
-
- # 'cygpath' may remove last slash for existing directories.
- $path .= '/' if($has_final_slash);
-
- # Remove any duplicated forward slashes (added by 'cygpath' for root
- # directories)
- $path =~ s{//+}{/}g;
-
- return $path;
- }
- elsif($^O eq 'msys') {
- # MSYS transforms automatically path to Windows native form in staring
- # program parameters if program is not MSYS-based.
-
- $path = do_msys_transform($path);
- return undef if !defined $path;
-
- # Capitalize drive letter for Windows paths.
- $path =~ s{^([a-z]:)}{\u$1};
-
- # Replace any back and duplicated slashes with single forward slashes.
- $path =~ s{[\\/]+}{/}g;
- return $path;
- }
- elsif($path =~ s{^([a-zA-Z]):[/\\]}{\u$1:/}) {
- # Path is already in Windows form. ('C:\path')
-
- # Replace any back and duplicated slashes with single forward slashes.
- $path =~ s{[\\/]+}{/}g;
- return $path;
- }
- elsif($path !~ m{^/}) {
- # Path is in relative form. ('path/name', './path' or '../path')
-
- # Replace any back and duplicated slashes with single forward slashes.
- $path =~ s{[\\/]+}{/}g;
- return $path;
- }
-
- # OS is Windows, but not MSYS, path is absolute, path is not in Windows
- # form and 'cygpath' is not available.
- return do_dumb_guessed_transform($path);
-}
-
#######################################################################
# Converts given path to system native absolute path, i.e. to Windows
# absolute format on Windows platform. Both relative and absolute
sub sys_native_abs_path {
my ($path) = @_;
- if(!os_is_win()) {
- # Convert path to absolute form.
- $path = Cwd::abs_path($path);
-
- # Do not process further on non-Windows platforms.
- return $path;
- }
-
- if($path =~ m{^([a-zA-Z]):($|[^/\\].*$)}) {
- # Path is single drive with colon or relative path on Windows drive.
- # ('C:' or 'C:path')
- # This kind of relative path is not processed correctly by 'cygpath'.
- # Get specified drive letter
- return get_abs_path_on_win32_drive($1, $2);
- }
- elsif($path eq '') {
- # Path is empty string. Return current directory.
- # Empty string processed correctly by 'cygpath'.
-
- return sys_native_current_path();
- }
- elsif(should_use_cygpath()) {
- # 'cygpath' is available - use it.
-
- my $has_final_slash = ($path =~ m{[\\/]$});
-
- # Remove leading duplicated forward and back slashes, as they may
- # prevent transforming and may be not processed.
- $path =~ s{^([\\/])[\\/]+}{$1}g;
-
- # some debugging? enable on need
- # print "Inter result: \"$path\"\n";
- # Use 'cygpath', '-m' means Windows path with forward slashes,
- # '-a' means absolute path
- chomp($path = `cygpath -m -a '$path'`);
- if($? != 0) {
- warn "Can't resolve path by usung \"cygpath\".\n";
- return undef;
- }
-
- # 'cygpath' may remove last slash for existing directories.
- $path .= '/' if($has_final_slash);
-
- # Remove any duplicated forward slashes (added by 'cygpath' for root
- # directories)
- $path =~ s{//+}{/}g;
-
- return $path
- }
- elsif($path =~ s{^([a-zA-Z]):[/\\]}{\u$1:/}) {
- # Path is already in Windows form. ('C:\path')
-
- # Replace any possible back slashes with forward slashes,
- # remove any duplicated slashes, resolve relative dirs.
- return normalize_path($path);
- }
- elsif(substr($path, 0, 1) eq '\\' ) {
- # Path is directory or filename on Windows current drive. ('\Windows')
+ # Return untouched on non-Windows platforms.
+ return Cwd::abs_path($path) if !os_is_win();
- my $w32drive = get_win32_current_drive();
- return undef if !defined $w32drive;
+ # Do not process empty path.
+ return $path if ($path eq '');
- # Combine drive and path.
- # Replace any possible back slashes with forward slashes,
- # remove any duplicated slashes, resolve relative dirs.
- return normalize_path($w32drive . $path);
+ my $res;
+ if($^O eq 'msys' || $^O eq 'cygwin') {
+ $res = Cygwin::posix_to_win_path(Cwd::abs_path($path));
}
-
- if(substr($path, 0, 1) ne '/') {
- # Path is in relative form. Resolve relative directories in Unix form
- # *BEFORE* converting to Windows form otherwise paths like
- # '../../../cygdrive/c/windows' will not be resolved.
-
- my $cur_dir;
- # MSYS shell has built-in command.
- if($^O eq 'msys') {
- $cur_dir = `bash -c 'pwd -L'`;
- }
- else {
- $cur_dir = `pwd -L`;
- }
- if($? != 0) {
- warn "Can't determine current working directory.\n";
- return undef;
- }
- chomp($cur_dir);
-
- $path = $cur_dir . '/' . $path;
+ elsif($path =~ m{^/(cygdrive/)?([a-z])/(.*)}) {
+ $res = uc($2) . ":/" . $3;
}
-
- # Resolve relative dirs.
- $path = normalize_path($path);
- return undef unless defined $path;
-
- if($^O eq 'msys') {
- # MSYS transforms automatically path to Windows native form in staring
- # program parameters if program is not MSYS-based.
- $path = do_msys_transform($path);
- return undef if !defined $path;
-
- # Replace any back and duplicated slashes with single forward slashes.
- $path =~ s{[\\/]+}{/}g;
- return $path;
+ else {
+ $res = Cwd::abs_path($path);
}
- # OS is Windows, but not MSYS, path is absolute, path is not in Windows
- # form and 'cygpath' is not available.
- return do_dumb_guessed_transform($path);
+ $res =~ s{[/\\]+}{/}g;
+ return $res;
}
-# Internal function. Converts given Unix-style absolute path to Windows format.
-sub simple_transform_win32_to_unix;
-
#######################################################################
# Converts given path to build system format absolute path, i.e. to
-# MSYS/Cygwin Unix-style absolute format on Windows platform. Both
+# MSYS/Cygwin POSIX-style absolute format on Windows platform. Both
# relative and absolute formats are supported for input.
#
sub build_sys_abs_path {
my ($path) = @_;
- if(!os_is_win()) {
- # Convert path to absolute form.
- $path = Cwd::abs_path($path);
-
- # Do not process further on non-Windows platforms.
- return $path;
- }
-
- if($path =~ m{^([a-zA-Z]):($|[^/\\].*$)}) {
- # Path is single drive with colon or relative path on Windows drive.
- # ('C:' or 'C:path')
- # This kind of relative path is not processed correctly by 'cygpath'.
- # Get specified drive letter
-
- # Resolve relative dirs in Windows-style path or paths like 'D:/../c/'
- # will be resolved incorrectly.
- # Replace any possible back slashes with forward slashes,
- # remove any duplicated slashes.
- $path = get_abs_path_on_win32_drive($1, $2);
- return undef if !defined $path;
-
- return simple_transform_win32_to_unix($path);
- }
- elsif($path eq '') {
- # Path is empty string. Return current directory.
- # Empty string processed correctly by 'cygpath'.
-
- # MSYS shell has built-in command.
- if($^O eq 'msys') {
- chomp($path = `bash -c 'pwd -L'`);
- }
- else {
- chomp($path = `pwd -L`);
- }
- if($? != 0) {
- warn "Can't determine Unix-style current working directory.\n";
- return undef;
- }
-
- # Add final slash if not at root dir.
- $path .= '/' if length($path) > 2;
- return $path;
- }
- elsif(should_use_cygpath()) {
- # 'cygpath' is available - use it.
-
- my $has_final_slash = ($path =~ m{[\\/]$});
-
- # Resolve relative directories, as they may be not resolved for
- # Unix-style paths.
- # Remove duplicated slashes, as they may be not processed.
- $path = normalize_path($path);
- return undef if !defined $path;
-
- # Use 'cygpath', '-u' means Unix-stile path,
- # '-a' means absolute path
- chomp($path = `cygpath -u -a '$path'`);
- if($? != 0) {
- warn "Can't resolve path by usung \"cygpath\".\n";
- return undef;
- }
-
- # 'cygpath' removes last slash if path is root dir on Windows drive.
- # Restore it.
- $path .= '/' if($has_final_slash &&
- substr($path, length($path) - 1, 1) ne '/');
-
- return $path
- }
- elsif($path =~ m{^[a-zA-Z]:[/\\]}) {
- # Path is already in Windows form. ('C:\path')
-
- # Resolve relative dirs in Windows-style path otherwise paths
- # like 'D:/../c/' will be resolved incorrectly.
- # Replace any possible back slashes with forward slashes,
- # remove any duplicated slashes.
- $path = normalize_path($path);
- return undef if !defined $path;
-
- return simple_transform_win32_to_unix($path);
- }
- elsif(substr($path, 0, 1) eq '\\') {
- # Path is directory or filename on Windows current drive. ('\Windows')
-
- my $w32drive = get_win32_current_drive();
- return undef if !defined $w32drive;
-
- # Combine drive and path.
- # Resolve relative dirs in Windows-style path or paths like 'D:/../c/'
- # will be resolved incorrectly.
- # Replace any possible back slashes with forward slashes,
- # remove any duplicated slashes.
- $path = normalize_path($w32drive . $path);
- return undef if !defined $path;
-
- return simple_transform_win32_to_unix($path);
- }
-
- # Path is not in any Windows form.
- if(substr($path, 0, 1) ne '/') {
- # Path in relative form. Resolve relative directories in Unix form
- # *BEFORE* converting to Windows form otherwise paths like
- # '../../../cygdrive/c/windows' will not be resolved.
-
- my $cur_dir;
- # MSYS shell has built-in command.
- if($^O eq 'msys') {
- $cur_dir = `bash -c 'pwd -L'`;
- }
- else {
- $cur_dir = `pwd -L`;
- }
- if($? != 0) {
- warn "Can't determine current working directory.\n";
- return undef;
- }
- chomp($cur_dir);
-
- $path = $cur_dir . '/' . $path;
- }
-
- return normalize_path($path);
-}
-
-#######################################################################
-# Performs path "normalization": all slashes converted to forward
-# slashes (except leading slash), all duplicated slashes are replaced
-# with single slashes, all relative directories ('./' and '../') are
-# resolved if possible.
-# Path processed as string, directories are not checked for presence so
-# path for not yet existing directory can be "normalized".
-#
-sub normalize_path {
- my ($path) = @_;
-
- # Don't process empty paths.
- return $path if $path eq '';
-
- if($path !~ m{(?:^|\\|/)\.{1,2}(?:\\|/|$)}) {
- # Speed up processing of simple paths.
- my $first_char = substr($path, 0, 1);
- $path =~ s{[\\/]+}{/}g;
- # Restore starting backslash if any.
- substr($path, 0, 1, $first_char);
- return $path;
- }
-
- my @arr;
- my $prefix;
- my $have_root = 0;
-
- # Check whether path starts from Windows drive. ('C:path' or 'C:\path')
- if($path =~ m{^([a-zA-Z]:(/|\\)?)(.*$)}) {
- $prefix = $1;
- $have_root = 1 if defined $2;
- # Process path separately from drive letter.
- @arr = split(m{\/|\\}, $3);
- # Replace backslash with forward slash if required.
- substr($prefix, 2, 1, '/') if $have_root;
- }
- else {
- if($path =~ m{^(\/|\\)}) {
- $have_root = 1;
- $prefix = $1;
- }
- else {
- $prefix = '';
- }
- @arr = split(m{\/|\\}, $path);
- }
-
- my $p = 0;
- my @res;
-
- for my $el (@arr) {
- if(length($el) == 0 || $el eq '.') {
- next;
- }
- elsif($el eq '..' && @res > 0 && $res[-1] ne '..') {
- pop @res;
- next;
- }
- push @res, $el;
- }
- if($have_root && @res > 0 && $res[0] eq '..') {
- warn "Error processing path \"$path\": " .
- "Parent directory of root directory does not exist!\n";
- return undef;
- }
-
- my $ret = $prefix . join('/', @res);
- $ret .= '/' if($path =~ m{\\$|/$} && scalar @res > 0);
-
- return $ret;
-}
-
-# Internal function. Converts path by using MSYS's built-in
-# transformation.
-sub do_msys_transform {
- my ($path) = @_;
- return undef if $^O ne 'msys';
- return $path if $path eq '';
-
- # Remove leading double forward slashes, as they turn off MSYS
- # transforming.
- $path =~ s{^/[/\\]+}{/};
-
- # MSYS transforms automatically path to Windows native form in staring
- # program parameters if program is not MSYS-based.
- # Note: already checked that $path is non-empty.
- $path = `cmd //c echo '$path'`;
- if($? != 0) {
- warn "Can't transform path into Windows form by using MSYS" .
- "internal transformation.\n";
- return undef;
- }
-
- # Remove double quotes, they are added for paths with spaces,
- # remove both '\r' and '\n'.
- $path =~ s{^\"|\"$|\"\r|\n|\r}{}g;
-
- return $path;
-}
+ # Return untouched on non-Windows platforms.
+ return Cwd::abs_path($path) if !os_is_win();
-# Internal function. Gets two parameters: first parameter must be single
-# drive letter ('c'), second optional parameter is path relative to drive's
-# current working directory. Returns Windows absolute normalized path.
-sub get_abs_path_on_win32_drive {
- my ($drv, $rel_path) = @_;
my $res;
-
- # Get current directory on specified drive.
- # "/c;" is compatible with both MSYS and Cygwin.
- my $cur_dir_on_drv = `cmd "/c;" echo %=$drv:%`;
- if($? != 0) {
- warn "Can't determine Windows current directory on drive $drv:.\n";
- return undef;
- }
-
- if($cur_dir_on_drv =~ m{^[%]}) {
- # Current directory on drive is not set, default is
- # root directory.
-
- $res = ucfirst($drv) . ':/';
+ if($^O eq 'msys' || $^O eq 'cygwin') {
+ $res = Cygwin::win_to_posix_path($path, 1);
}
else {
- # Current directory on drive was set.
- # Remove both '\r' and '\n'.
- $cur_dir_on_drv =~ s{\n|\r}{}g;
-
- # Append relative path part.
- $res = $cur_dir_on_drv . '/';
- }
- $res .= $rel_path if defined $rel_path;
-
- # Replace any possible back slashes with forward slashes,
- # remove any duplicated slashes, resolve relative dirs.
- return normalize_path($res);
-}
-
-# Internal function. Tries to find or guess Windows version of given
-# absolute Unix-style path. Other types of paths are not supported.
-# Returned paths contain only single forward slashes (no back and
-# duplicated slashes).
-# Last resort. Used only when other transformations are not available.
-sub do_dumb_guessed_transform {
- my ($path) = @_;
+ $res = Cwd::abs_path($path);
- # Replace any possible back slashes and duplicated forward slashes
- # with single forward slashes.
- $path =~ s{[/\\]+}{/}g;
-
- # Empty path is not valid.
- return undef if (length($path) == 0);
-
- # RE to find Windows drive letter
- my $drv_ltr_re = drives_mounted_on_cygdrive() ?
- qr{^/cygdrive/([a-zA-Z])($|/.*$)} :
- qr{^/([a-zA-Z])($|/.*$)};
-
- # Check path whether path is Windows directly mapped drive and try to
- # transform it assuming that drive letter is matched to Windows drive letter.
- if($path =~ m{$drv_ltr_re}) {
- return ucfirst($1) . ':/' if(length($2) == 0);
- return ucfirst($1) . ':' . $2;
- }
-
- # This may be some custom mapped path. ('/mymount/path')
-
- # Must check longest possible path component as subdir can be mapped to
- # different directory. For example '/usr/bin/' can be mapped to '/bin/' or
- # '/bin/' can be mapped to '/usr/bin/'.
- my $check_path = $path;
- my $path_tail = '';
- while(1) {
- if(-d $check_path) {
- my $res =
- `(cd "$check_path" && cmd /c "echo %__CD__%") 2>$dev_null`;
- if($? == 0 && substr($path, 0, 1) ne '%') {
- # Remove both '\r' and '\n'.
- $res =~ s{\n|\r}{}g;
-
- # Replace all back slashes with forward slashes.
- $res =~ s{\\}{/}g;
-
- if(length($path_tail) > 0) {
- return $res . $path_tail;
- }
- else {
- $res =~ s{/$}{} if $check_path !~ m{/$};
- return $res;
- }
- }
- }
- if($check_path =~ m{(^.*/)([^/]+/*)}) {
- $check_path = $1;
- $path_tail = $2 . $path_tail;
- }
- else {
- # Shouldn't happens as root '/' directory should always
- # be resolvable.
- warn "Can't determine Windows directory for path \"$path\".\n";
- return undef;
- }
- }
-}
-
-
-# Internal function. Converts given Unix-style absolute path to Windows format.
-sub simple_transform_win32_to_unix {
- my ($path) = @_;
-
- if(should_use_cygpath()) {
- # 'cygpath' gives precise result.
- my $res;
- chomp($res = `cygpath -a -u '$path'`);
- if($? != 0) {
- warn "Can't determine Unix-style directory for Windows " .
- "directory \"$path\".\n";
- return undef;
+ if($res =~ m{^([A-Za-z]):(.*)}) {
+ $res = "/" . lc($1) . $2;
+ $res = '/cygdrive' . $res if(drives_mounted_on_cygdrive());
}
-
- # 'cygpath' removes last slash if path is root dir on Windows drive.
- $res .= '/' if(substr($res, length($res) - 1, 1) ne '/' &&
- $path =~ m{[/\\]$});
- return $res;
- }
-
- # 'cygpath' is not available, use guessed transformation.
- if($path !~ s{^([a-zA-Z]):(?:/|\\)}{/\l$1/}) {
- warn "Can't determine Unix-style directory for Windows " .
- "directory \"$path\".\n";
- return undef;
}
- $path = '/cygdrive' . $path if(drives_mounted_on_cygdrive());
- return $path;
+ return $res;
}
-#
+
#***************************************************************************
# Return file extension for executable files on this operating system
#
projects / thirdparty / curl.git / commitdiff
