123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795 |
- ###########################################################################
- # _ _ ____ _
- # Project ___| | | | _ \| |
- # / __| | | | |_) | |
- # | (__| |_| | _ <| |___
- # \___|\___/|_| \_\_____|
- #
- # Copyright (C) Evgeny Grin (Karlson2k), <k2k@narod.ru>.
- #
- # This software is licensed as described in the file COPYING, which
- # you should have received as part of this distribution. The terms
- # are also available at https://curl.se/docs/copyright.html.
- #
- # You may opt to use, copy, modify, merge, publish, distribute and/or sell
- # copies of the Software, and permit persons to whom the Software is
- # furnished to do so, under the terms of the COPYING file.
- #
- # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
- # KIND, either express or implied.
- #
- # SPDX-License-Identifier: curl
- #
- ###########################################################################
- # This Perl package helps with path transforming when running curl tests on
- # Win32 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
- # (2) D:/some/path - absolute path in Win32-style
- # (3) some/path - relative path
- # (4) D:some/path - path relative to current directory on Win32 drive (paths
- # like 'D:' are treated as 'D:./') (*)
- # (5) \some/path - path from root directory on current Win32 drive (*)
- # All forward '/' and back '\' slashes are treated identically except leading
- # 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 Win32 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 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
- # Perl's functions or return unmodified string (depending on functionality),
- # so all functions can be unconditionally used on all platforms.
- #
- # (*) CAUTION! Forms (4) and (5) are not recommended to use as they can be
- # interpreted incorrectly in Perl and Msys/Cygwin environment have low
- # control on Win32 current drive and Win32 current path on specific drive.
- package pathhelp;
- use strict;
- use warnings;
- use Cwd 'abs_path';
- BEGIN {
- use base qw(Exporter);
- our @EXPORT_OK = qw(
- os_is_win
- exe_ext
- sys_native_abs_path
- sys_native_current_path
- build_sys_abs_path
- normalize_path
- should_use_cygpath
- drives_mounted_on_cygdrive
- );
- }
- #######################################################################
- # Block for cached static variables
- #
- {
- # Cached static variable, Perl 5.0-compatible.
- my $is_win = $^O eq 'MSWin32'
- || $^O eq 'cygwin'
- || $^O eq 'msys';
- # Returns boolean true if OS is any form of Windows.
- sub os_is_win {
- return $is_win;
- }
- # Cached static variable, Perl 5.0-compatible.
- my $cygdrive_present;
- # Returns boolean true if Win32 drives mounted with '/cygdrive/' prefix.
- sub drives_mounted_on_cygdrive {
- return $cygdrive_present if defined $cygdrive_present;
- $cygdrive_present = ((-e '/cygdrive/') && (-d '/cygdrive/')) ? 1 : 0;
- return $cygdrive_present;
- }
- }
- my $use_cygpath; # Only for Win32:
- # 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 Win32 format on Windows.
- #
- sub sys_native_current_path {
- 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 Win32 current directory.\n";
- return undef;
- }
- # Add final slash if required.
- $cur_dir .= '/' if length($cur_dir) > 3;
- }
- 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 Win32 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;
- }
- return $cur_dir;
- }
- #######################################################################
- # Returns Win32 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 Win32 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 Win32 absolute normalized path.
- sub get_abs_path_on_win32_drive;
- # Internal function. Tries to find or guess Win32 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 Win32 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 Win32 current drive or relative
- # path on current directory on specific Win32 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 Win32 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 Win32 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 Win32 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 Win32 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 Win32
- # form and 'cygpath' is not available.
- return do_dumb_guessed_transform($path);
- }
- #######################################################################
- # Converts given path to system native absolute path, i.e. to Win32
- # absolute format on Windows platform. Both relative and absolute
- # formats are supported for input.
- #
- 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 Win32 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;
- print "Inter result: \"$path\"\n";
- # Use 'cygpath', '-m' means Win32 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 Win32 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 Win32 current drive. ('\Windows')
- my $w32drive = get_win32_current_drive();
- return undef if !defined $w32drive;
- # Combine drive and path.
- # Replace any possible back slashes with forward slashes,
- # remove any duplicated slashes, resolve relative dirs.
- return normalize_path($w32drive . $path);
- }
- if(substr($path, 0, 1) ne '/') {
- # Path is in relative form. Resolve relative directories in Unix form
- # *BEFORE* converting to Win32 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;
- }
- # 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;
- }
- # OS is Windows, but not Msys, path is absolute, path is not in Win32
- # form and 'cygpath' is not available.
- return do_dumb_guessed_transform($path);
- }
- # Internal function. Converts given Unix-style absolute path to Win32 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
- # 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 Win32 drive.
- # ('C:' or 'C:path')
- # This kind of relative path is not processed correctly by 'cygpath'.
- # Get specified drive letter
- # Resolve relative dirs in Win32-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 Win32 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 Win32 form. ('C:\path')
- # Resolve relative dirs in Win32-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 Win32 current drive. ('\Windows')
- my $w32drive = get_win32_current_drive();
- return undef if !defined $w32drive;
- # Combine drive and path.
- # Resolve relative dirs in Win32-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 Win32 form.
- if(substr($path, 0, 1) ne '/') {
- # Path in relative form. Resolve relative directories in Unix form
- # *BEFORE* converting to Win32 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 Win32 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 Win32 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;
- }
- # 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 Win32 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 Win32 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) . ':/';
- }
- 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 Win32 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) = @_;
- # 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 Win32 drive letter
- my $drv_ltr_re = drives_mounted_on_cygdrive() ?
- qr{^/cygdrive/([a-zA-Z])($|/.*$)} :
- qr{^/([a-zA-Z])($|/.*$)};
- # Check path whether path is Win32 directly mapped drive and try to
- # transform it assuming that drive letter is matched to Win32 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 Win32 directory for path \"$path\".\n";
- return undef;
- }
- }
- }
- # Internal function. Converts given Unix-style absolute path to Win32 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 Win32 " .
- "directory \"$path\".\n";
- return undef;
- }
- # 'cygpath' removes last slash if path is root dir on Win32 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 Win32 " .
- "directory \"$path\".\n";
- return undef;
- }
- $path = '/cygdrive' . $path if(drives_mounted_on_cygdrive());
- return $path;
- }
- #
- #***************************************************************************
- # Return file extension for executable files on this operating system
- #
- sub exe_ext {
- my ($component, @arr) = @_;
- if ($ENV{'CURL_TEST_EXE_EXT'}) {
- return $ENV{'CURL_TEST_EXE_EXT'};
- }
- if ($ENV{'CURL_TEST_EXE_EXT_'.$component}) {
- return $ENV{'CURL_TEST_EXE_EXT_'.$component};
- }
- if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'msys' ||
- $^O eq 'dos' || $^O eq 'os2') {
- return '.exe';
- }
- return '';
- }
- 1; # End of module
|