1########################################################################### 2# _ _ ____ _ 3# Project ___| | | | _ \| | 4# / __| | | | |_) | | 5# | (__| |_| | _ <| |___ 6# \___|\___/|_| \_\_____| 7# 8# Copyright (C) Evgeny Grin (Karlson2k), <k2k@narod.ru>. 9# 10# This software is licensed as described in the file COPYING, which 11# you should have received as part of this distribution. The terms 12# are also available at https://curl.se/docs/copyright.html. 13# 14# You may opt to use, copy, modify, merge, publish, distribute and/or sell 15# copies of the Software, and permit persons to whom the Software is 16# furnished to do so, under the terms of the COPYING file. 17# 18# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY 19# KIND, either express or implied. 20# 21# SPDX-License-Identifier: curl 22# 23########################################################################### 24 25# This Perl package helps with path transforming when running curl tests on 26# native Windows and MSYS/Cygwin. 27# Following input formats are supported (via built-in Perl functions): 28# (1) /some/path - absolute path in POSIX-style 29# (2) D:/some/path - absolute path in Windows-style 30# (3) some/path - relative path 31# (4) D:some/path - path relative to current directory on Windows drive 32# (paths like 'D:' are treated as 'D:./') (*) 33# (5) \some/path - path from root directory on current Windows drive (*) 34# All forward '/' and back '\' slashes are treated identically except leading 35# slash in forms (1) and (5). 36# Forward slashes are simpler processed in Perl, do not require extra escaping 37# for shell (unlike back slashes) and accepted by Windows native programs, so 38# all functions return paths with only forward slashes. 39# All returned paths don't contain any duplicated slashes, only single slashes 40# are used as directory separators on output. 41# On non-Windows platforms functions acts as transparent wrappers for similar 42# Perl's functions or return unmodified string (depending on functionality), 43# so all functions can be unconditionally used on all platforms. 44# 45# (*) CAUTION! Forms (4) and (5) are not recommended to use as they can be 46# interpreted incorrectly in Perl and MSYS/Cygwin environment have low 47# control on Windows current drive and Windows current path on specific 48# drive. 49 50package pathhelp; 51 52use strict; 53use warnings; 54use Cwd 'abs_path'; 55 56BEGIN { 57 use base qw(Exporter); 58 59 our @EXPORT_OK = qw( 60 os_is_win 61 exe_ext 62 sys_native_abs_path 63 sys_native_current_path 64 build_sys_abs_path 65 ); 66} 67 68 69####################################################################### 70# Block for cached static variables 71# 72{ 73 # Cached static variable, Perl 5.0-compatible. 74 my $is_win = $^O eq 'MSWin32' 75 || $^O eq 'cygwin' 76 || $^O eq 'msys'; 77 78 # Returns boolean true if OS is any form of Windows. 79 sub os_is_win { 80 return $is_win; 81 } 82 83 # Cached static variable, Perl 5.0-compatible. 84 my $cygdrive_present; 85 86 # Returns boolean true if Windows drives mounted with '/cygdrive/' prefix. 87 sub drives_mounted_on_cygdrive { 88 return $cygdrive_present if defined $cygdrive_present; 89 $cygdrive_present = ((-e '/cygdrive/') && (-d '/cygdrive/')) ? 1 : 0; 90 return $cygdrive_present; 91 } 92} 93 94####################################################################### 95# Returns current working directory in Windows format on Windows. 96# 97sub sys_native_current_path { 98 return Cwd::getcwd() if !os_is_win(); 99 100 my $cur_dir; 101 if($^O eq 'MSWin32') { 102 $cur_dir = Cwd::getcwd(); 103 } 104 else { 105 $cur_dir = Cygwin::posix_to_win_path(Cwd::getcwd()); 106 } 107 $cur_dir =~ s{[/\\]+}{/}g; 108 return $cur_dir; 109} 110 111####################################################################### 112# Converts given path to system native absolute path, i.e. to Windows 113# absolute format on Windows platform. Both relative and absolute 114# formats are supported for input. 115# 116sub sys_native_abs_path { 117 my ($path) = @_; 118 119 # Return untouched on non-Windows platforms. 120 return Cwd::abs_path($path) if !os_is_win(); 121 122 # Do not process empty path. 123 return $path if ($path eq ''); 124 125 my $res; 126 if($^O eq 'msys' || $^O eq 'cygwin') { 127 $res = Cygwin::posix_to_win_path(Cwd::abs_path($path)); 128 } 129 elsif($path =~ m{^/(cygdrive/)?([a-z])/(.*)}) { 130 $res = uc($2) . ":/" . $3; 131 } 132 else { 133 $res = Cwd::abs_path($path); 134 } 135 136 $res =~ s{[/\\]+}{/}g; 137 return $res; 138} 139 140####################################################################### 141# Converts given path to build system format absolute path, i.e. to 142# MSYS/Cygwin POSIX-style absolute format on Windows platform. Both 143# relative and absolute formats are supported for input. 144# 145sub build_sys_abs_path { 146 my ($path) = @_; 147 148 # Return untouched on non-Windows platforms. 149 return Cwd::abs_path($path) if !os_is_win(); 150 151 my $res; 152 if($^O eq 'msys' || $^O eq 'cygwin') { 153 $res = Cygwin::win_to_posix_path($path, 1); 154 } 155 else { 156 $res = Cwd::abs_path($path); 157 158 if($res =~ m{^([A-Za-z]):(.*)}) { 159 $res = "/" . lc($1) . $2; 160 $res = '/cygdrive' . $res if(drives_mounted_on_cygdrive()); 161 } 162 } 163 164 return $res; 165} 166 167#*************************************************************************** 168# Return file extension for executable files on this operating system 169# 170sub exe_ext { 171 my ($component, @arr) = @_; 172 if ($ENV{'CURL_TEST_EXE_EXT'}) { 173 return $ENV{'CURL_TEST_EXE_EXT'}; 174 } 175 if ($ENV{'CURL_TEST_EXE_EXT_'.$component}) { 176 return $ENV{'CURL_TEST_EXE_EXT_'.$component}; 177 } 178 if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'msys' || 179 $^O eq 'dos' || $^O eq 'os2') { 180 return '.exe'; 181 } 182 return ''; 183} 184 1851; # End of module 186
