xf.li | 6c8fc1e | 2023-08-12 00:11:09 -0700 | [diff] [blame] | 1 | ########################################################################### |
| 2 | # _ _ ____ _ |
| 3 | # Project ___| | | | _ \| | |
| 4 | # / __| | | | |_) | | |
| 5 | # | (__| |_| | _ <| |___ |
| 6 | # \___|\___/|_| \_\_____| |
| 7 | # |
| 8 | # Copyright (C) 2016 - 2022, 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 | # Win32 platform with Msys or Cygwin. |
| 27 | # Three main functions 'sys_native_abs_path', 'sys_native_path' and |
| 28 | # 'build_sys_abs_path' autodetect format of given pathnames. Following formats |
| 29 | # are supported: |
| 30 | # (1) /some/path - absolute path in Unix-style |
| 31 | # (2) D:/some/path - absolute path in Win32-style |
| 32 | # (3) some/path - relative path |
| 33 | # (4) D:some/path - path relative to current directory on Win32 drive (paths |
| 34 | # like 'D:' are treated as 'D:./') (*) |
| 35 | # (5) \some/path - path from root directory on current Win32 drive (*) |
| 36 | # All forward '/' and back '\' slashes are treated identically except leading |
| 37 | # slash in forms (1) and (5). |
| 38 | # Forward slashes are simpler processed in Perl, do not require extra escaping |
| 39 | # for shell (unlike back slashes) and accepted by Win32 native programs, so |
| 40 | # all functions return paths with only forward slashes except |
| 41 | # 'sys_native_path' which returns paths with first forward slash for form (5). |
| 42 | # All returned paths don't contain any duplicated slashes, only single slashes |
| 43 | # are used as directory separators on output. |
| 44 | # On non-Windows platforms functions acts as transparent wrappers for similar |
| 45 | # Perl's functions or return unmodified string (depending on functionality), |
| 46 | # so all functions can be unconditionally used on all platforms. |
| 47 | # |
| 48 | # (*) CAUTION! Forms (4) and (5) are not recommended to use as they can be |
| 49 | # interpreted incorrectly in Perl and Msys/Cygwin environment have low |
| 50 | # control on Win32 current drive and Win32 current path on specific drive. |
| 51 | |
| 52 | |
| 53 | package pathhelp; |
| 54 | use strict; |
| 55 | use warnings; |
| 56 | use Cwd 'abs_path'; |
| 57 | |
| 58 | BEGIN { |
| 59 | require Exporter; |
| 60 | |
| 61 | our @ISA = qw(Exporter); |
| 62 | |
| 63 | our @EXPORT = qw( |
| 64 | sys_native_abs_path |
| 65 | sys_native_path |
| 66 | ); |
| 67 | |
| 68 | our @EXPORT_OK = qw( |
| 69 | build_sys_abs_path |
| 70 | sys_native_current_path |
| 71 | normalize_path |
| 72 | os_is_win |
| 73 | $use_cygpath |
| 74 | should_use_cygpath |
| 75 | drives_mounted_on_cygdrive |
| 76 | ); |
| 77 | } |
| 78 | |
| 79 | |
| 80 | ####################################################################### |
| 81 | # Block for cached static variables |
| 82 | # |
| 83 | { |
| 84 | # Cached static variable, Perl 5.0-compatible. |
| 85 | my $is_win = $^O eq 'MSWin32' |
| 86 | || $^O eq 'cygwin' |
| 87 | || $^O eq 'msys'; |
| 88 | |
| 89 | # Returns boolean true if OS is any form of Windows. |
| 90 | sub os_is_win { |
| 91 | return $is_win; |
| 92 | } |
| 93 | |
| 94 | # Cached static variable, Perl 5.0-compatible. |
| 95 | my $cygdrive_present; |
| 96 | |
| 97 | # Returns boolean true if Win32 drives mounted with '/cygdrive/' prefix. |
| 98 | sub drives_mounted_on_cygdrive { |
| 99 | return $cygdrive_present if defined $cygdrive_present; |
| 100 | $cygdrive_present = ((-e '/cygdrive/') && (-d '/cygdrive/')) ? 1 : 0; |
| 101 | return $cygdrive_present; |
| 102 | } |
| 103 | } |
| 104 | |
| 105 | our $use_cygpath; # Only for Win32: |
| 106 | # undef - autodetect |
| 107 | # 1 - use cygpath |
| 108 | # 0 - do not use cygpath |
| 109 | |
| 110 | # Returns boolean true if 'cygpath' utility should be used for path conversion. |
| 111 | sub should_use_cygpath { |
| 112 | unless (os_is_win()) { |
| 113 | $use_cygpath = 0; |
| 114 | return 0; |
| 115 | } |
| 116 | return $use_cygpath if defined $use_cygpath; |
| 117 | |
| 118 | $use_cygpath = (qx{cygpath -u '.\\' 2>/dev/null} eq "./\n" && $? == 0); |
| 119 | |
| 120 | return $use_cygpath; |
| 121 | } |
| 122 | |
| 123 | ####################################################################### |
| 124 | # Performs path "normalization": all slashes converted to forward |
| 125 | # slashes (except leading slash), all duplicated slashes are replaced |
| 126 | # with single slashes, all relative directories ('./' and '../') are |
| 127 | # resolved if possible. |
| 128 | # Path processed as string, directories are not checked for presence so |
| 129 | # path for not yet existing directory can be "normalized". |
| 130 | # |
| 131 | sub normalize_path; |
| 132 | |
| 133 | ####################################################################### |
| 134 | # Returns current working directory in Win32 format on Windows. |
| 135 | # |
| 136 | sub sys_native_current_path { |
| 137 | return Cwd::getcwd() unless os_is_win(); |
| 138 | |
| 139 | my $cur_dir; |
| 140 | if($^O eq 'msys') { |
| 141 | # MSys shell has built-in command. |
| 142 | chomp($cur_dir = `bash -c 'pwd -W'`); |
| 143 | if($? != 0) { |
| 144 | warn "Can't determine Win32 current directory.\n"; |
| 145 | return undef; |
| 146 | } |
| 147 | # Add final slash if required. |
| 148 | $cur_dir .= '/' if length($cur_dir) > 3; |
| 149 | } |
| 150 | else { |
| 151 | # Do not use 'cygpath' - it falsely succeed on paths like '/cygdrive'. |
| 152 | $cur_dir = `cmd "/c;" echo %__CD__%`; |
| 153 | if($? != 0 || substr($cur_dir, 0, 1) eq '%') { |
| 154 | warn "Can't determine Win32 current directory.\n"; |
| 155 | return undef; |
| 156 | } |
| 157 | # Remove both '\r' and '\n'. |
| 158 | $cur_dir =~ s{\n|\r}{}g; |
| 159 | |
| 160 | # Replace back slashes with forward slashes. |
| 161 | $cur_dir =~ s{\\}{/}g; |
| 162 | } |
| 163 | return $cur_dir; |
| 164 | } |
| 165 | |
| 166 | ####################################################################### |
| 167 | # Returns Win32 current drive letter with colon. |
| 168 | # |
| 169 | sub get_win32_current_drive { |
| 170 | # Notice parameter "/c;" - it's required to turn off Msys's |
| 171 | # transformation of '/c' and compatible with Cygwin. |
| 172 | my $drive_letter = `cmd "/c;" echo %__CD__:~0,2%`; |
| 173 | if($? != 0 || substr($drive_letter, 1, 1) ne ':') { |
| 174 | warn "Can't determine current Win32 drive letter.\n"; |
| 175 | return undef; |
| 176 | } |
| 177 | |
| 178 | return substr($drive_letter, 0, 2); |
| 179 | } |
| 180 | |
| 181 | # Internal function. Converts path by using Msys's built-in transformation. |
| 182 | # Returned path may contain duplicated and back slashes. |
| 183 | sub do_msys_transform; |
| 184 | |
| 185 | # Internal function. Gets two parameters: first parameter must be single |
| 186 | # drive letter ('c'), second optional parameter is path relative to drive's |
| 187 | # current working directory. Returns Win32 absolute normalized path. |
| 188 | sub get_abs_path_on_win32_drive; |
| 189 | |
| 190 | # Internal function. Tries to find or guess Win32 version of given |
| 191 | # absolute Unix-style path. Other types of paths are not supported. |
| 192 | # Returned paths contain only single forward slashes (no back and |
| 193 | # duplicated slashes). |
| 194 | # Last resort. Used only when other transformations are not available. |
| 195 | sub do_dumb_guessed_transform; |
| 196 | |
| 197 | ####################################################################### |
| 198 | # Converts given path to system native format, i.e. to Win32 format on |
| 199 | # Windows platform. Relative paths converted to relative, absolute |
| 200 | # paths converted to absolute. |
| 201 | # |
| 202 | sub sys_native_path { |
| 203 | my ($path) = @_; |
| 204 | |
| 205 | # Return untouched on non-Windows platforms. |
| 206 | return $path unless (os_is_win()); |
| 207 | |
| 208 | # Do not process empty path. |
| 209 | return $path if ($path eq ''); |
| 210 | |
| 211 | if($path =~ s{^([a-zA-Z]):$}{\u$1:}) { |
| 212 | # Path is single drive with colon. (C:) |
| 213 | # This type of paths is not processed correctly by 'cygpath'. |
| 214 | # WARNING! |
| 215 | # Be careful, this relative path can be accidentally transformed |
| 216 | # into wrong absolute path by adding to it some '/dirname' with |
| 217 | # slash at font. |
| 218 | return $path; |
| 219 | } |
| 220 | elsif($path =~ m{^\\} || $path =~ m{^[a-zA-Z]:[^/\\]}) { |
| 221 | # Path is a directory or filename on Win32 current drive or relative |
| 222 | # path on current directory on specific Win32 drive. |
| 223 | # ('\path' or 'D:path') |
| 224 | # First type of paths is not processed by Msys transformation and |
| 225 | # resolved to absolute path by 'cygpath'. |
| 226 | # Second type is not processed by Msys transformation and may be |
| 227 | # incorrectly processed by 'cygpath' (for paths like 'D:..\../.\') |
| 228 | |
| 229 | my $first_char = ucfirst(substr($path, 0, 1)); |
| 230 | |
| 231 | # Replace any back and duplicated slashes with single forward slashes. |
| 232 | $path =~ s{[\\/]+}{/}g; |
| 233 | |
| 234 | # Convert leading slash back to forward slash to indicate |
| 235 | # directory on Win32 current drive or capitalize drive letter. |
| 236 | substr($path, 0, 1) = $first_char; |
| 237 | return $path; |
| 238 | } |
| 239 | elsif(should_use_cygpath()) { |
| 240 | # 'cygpath' is available - use it. |
| 241 | |
| 242 | # Remove leading duplicated forward and back slashes, as they may |
| 243 | # prevent transforming and may be not processed. |
| 244 | $path =~ s{^([\\/])[\\/]+}{$1}g; |
| 245 | |
| 246 | my $has_final_slash = ($path =~ m{[/\\]$}); |
| 247 | |
| 248 | # Use 'cygpath', '-m' means Win32 path with forward slashes. |
| 249 | chomp($path = `cygpath -m '$path'`); |
| 250 | if ($? != 0) { |
| 251 | warn "Can't convert path by \"cygpath\".\n"; |
| 252 | return undef; |
| 253 | } |
| 254 | |
| 255 | # 'cygpath' may remove last slash for existing directories. |
| 256 | $path .= '/' if($has_final_slash); |
| 257 | |
| 258 | # Remove any duplicated forward slashes (added by 'cygpath' for root |
| 259 | # directories) |
| 260 | $path =~ s{//+}{/}g; |
| 261 | |
| 262 | return $path; |
| 263 | } |
| 264 | elsif($^O eq 'msys') { |
| 265 | # Msys transforms automatically path to Windows native form in staring |
| 266 | # program parameters if program is not Msys-based. |
| 267 | |
| 268 | $path = do_msys_transform($path); |
| 269 | return undef unless defined $path; |
| 270 | |
| 271 | # Capitalize drive letter for Win32 paths. |
| 272 | $path =~ s{^([a-z]:)}{\u$1}; |
| 273 | |
| 274 | # Replace any back and duplicated slashes with single forward slashes. |
| 275 | $path =~ s{[\\/]+}{/}g; |
| 276 | return $path; |
| 277 | } |
| 278 | elsif($path =~ s{^([a-zA-Z]):[/\\]}{\u$1:/}) { |
| 279 | # Path is already in Win32 form. ('C:\path') |
| 280 | |
| 281 | # Replace any back and duplicated slashes with single forward slashes. |
| 282 | $path =~ s{[\\/]+}{/}g; |
| 283 | return $path; |
| 284 | } |
| 285 | elsif($path !~ m{^/}) { |
| 286 | # Path is in relative form. ('path/name', './path' or '../path') |
| 287 | |
| 288 | # Replace any back and duplicated slashes with single forward slashes. |
| 289 | $path =~ s{[\\/]+}{/}g; |
| 290 | return $path; |
| 291 | } |
| 292 | |
| 293 | # OS is Windows, but not Msys, path is absolute, path is not in Win32 |
| 294 | # form and 'cygpath' is not available. |
| 295 | return do_dumb_guessed_transform($path); |
| 296 | } |
| 297 | |
| 298 | ####################################################################### |
| 299 | # Converts given path to system native absolute path, i.e. to Win32 |
| 300 | # absolute format on Windows platform. Both relative and absolute |
| 301 | # formats are supported for input. |
| 302 | # |
| 303 | sub sys_native_abs_path { |
| 304 | my ($path) = @_; |
| 305 | |
| 306 | unless(os_is_win()) { |
| 307 | # Convert path to absolute form. |
| 308 | $path = Cwd::abs_path($path); |
| 309 | |
| 310 | # Do not process further on non-Windows platforms. |
| 311 | return $path; |
| 312 | } |
| 313 | |
| 314 | if($path =~ m{^([a-zA-Z]):($|[^/\\].*$)}) { |
| 315 | # Path is single drive with colon or relative path on Win32 drive. |
| 316 | # ('C:' or 'C:path') |
| 317 | # This kind of relative path is not processed correctly by 'cygpath'. |
| 318 | # Get specified drive letter |
| 319 | return get_abs_path_on_win32_drive($1, $2); |
| 320 | } |
| 321 | elsif($path eq '') { |
| 322 | # Path is empty string. Return current directory. |
| 323 | # Empty string processed correctly by 'cygpath'. |
| 324 | |
| 325 | return sys_native_current_path(); |
| 326 | } |
| 327 | elsif(should_use_cygpath()) { |
| 328 | # 'cygpath' is available - use it. |
| 329 | |
| 330 | my $has_final_slash = ($path =~ m{[\\/]$}); |
| 331 | |
| 332 | # Remove leading duplicated forward and back slashes, as they may |
| 333 | # prevent transforming and may be not processed. |
| 334 | $path =~ s{^([\\/])[\\/]+}{$1}g; |
| 335 | |
| 336 | print "Inter result: \"$path\"\n"; |
| 337 | # Use 'cygpath', '-m' means Win32 path with forward slashes, |
| 338 | # '-a' means absolute path |
| 339 | chomp($path = `cygpath -m -a '$path'`); |
| 340 | if($? != 0) { |
| 341 | warn "Can't resolve path by usung \"cygpath\".\n"; |
| 342 | return undef; |
| 343 | } |
| 344 | |
| 345 | # 'cygpath' may remove last slash for existing directories. |
| 346 | $path .= '/' if($has_final_slash); |
| 347 | |
| 348 | # Remove any duplicated forward slashes (added by 'cygpath' for root |
| 349 | # directories) |
| 350 | $path =~ s{//+}{/}g; |
| 351 | |
| 352 | return $path |
| 353 | } |
| 354 | elsif($path =~ s{^([a-zA-Z]):[/\\]}{\u$1:/}) { |
| 355 | # Path is already in Win32 form. ('C:\path') |
| 356 | |
| 357 | # Replace any possible back slashes with forward slashes, |
| 358 | # remove any duplicated slashes, resolve relative dirs. |
| 359 | return normalize_path($path); |
| 360 | } |
| 361 | elsif(substr($path, 0, 1) eq '\\' ) { |
| 362 | # Path is directory or filename on Win32 current drive. ('\Windows') |
| 363 | |
| 364 | my $w32drive = get_win32_current_drive(); |
| 365 | return undef unless defined $w32drive; |
| 366 | |
| 367 | # Combine drive and path. |
| 368 | # Replace any possible back slashes with forward slashes, |
| 369 | # remove any duplicated slashes, resolve relative dirs. |
| 370 | return normalize_path($w32drive . $path); |
| 371 | } |
| 372 | |
| 373 | unless (substr($path, 0, 1) eq '/') { |
| 374 | # Path is in relative form. Resolve relative directories in Unix form |
| 375 | # *BEFORE* converting to Win32 form otherwise paths like |
| 376 | # '../../../cygdrive/c/windows' will not be resolved. |
| 377 | |
| 378 | my $cur_dir; |
| 379 | # MSys shell has built-in command. |
| 380 | if($^O eq 'msys') { |
| 381 | $cur_dir = `bash -c 'pwd -L'`; |
| 382 | } |
| 383 | else { |
| 384 | $cur_dir = `pwd -L`; |
| 385 | } |
| 386 | if($? != 0) { |
| 387 | warn "Can't determine current working directory.\n"; |
| 388 | return undef; |
| 389 | } |
| 390 | chomp($cur_dir); |
| 391 | |
| 392 | $path = $cur_dir . '/' . $path; |
| 393 | } |
| 394 | |
| 395 | # Resolve relative dirs. |
| 396 | $path = normalize_path($path); |
| 397 | return undef unless defined $path; |
| 398 | |
| 399 | if($^O eq 'msys') { |
| 400 | # Msys transforms automatically path to Windows native form in staring |
| 401 | # program parameters if program is not Msys-based. |
| 402 | $path = do_msys_transform($path); |
| 403 | return undef unless defined $path; |
| 404 | |
| 405 | # Replace any back and duplicated slashes with single forward slashes. |
| 406 | $path =~ s{[\\/]+}{/}g; |
| 407 | return $path; |
| 408 | } |
| 409 | # OS is Windows, but not Msys, path is absolute, path is not in Win32 |
| 410 | # form and 'cygpath' is not available. |
| 411 | |
| 412 | return do_dumb_guessed_transform($path); |
| 413 | } |
| 414 | |
| 415 | # Internal function. Converts given Unix-style absolute path to Win32 format. |
| 416 | sub simple_transform_win32_to_unix; |
| 417 | |
| 418 | ####################################################################### |
| 419 | # Converts given path to build system format absolute path, i.e. to |
| 420 | # Msys/Cygwin Unix-style absolute format on Windows platform. Both |
| 421 | # relative and absolute formats are supported for input. |
| 422 | # |
| 423 | sub build_sys_abs_path { |
| 424 | my ($path) = @_; |
| 425 | |
| 426 | unless(os_is_win()) { |
| 427 | # Convert path to absolute form. |
| 428 | $path = Cwd::abs_path($path); |
| 429 | |
| 430 | # Do not process further on non-Windows platforms. |
| 431 | return $path; |
| 432 | } |
| 433 | |
| 434 | if($path =~ m{^([a-zA-Z]):($|[^/\\].*$)}) { |
| 435 | # Path is single drive with colon or relative path on Win32 drive. |
| 436 | # ('C:' or 'C:path') |
| 437 | # This kind of relative path is not processed correctly by 'cygpath'. |
| 438 | # Get specified drive letter |
| 439 | |
| 440 | # Resolve relative dirs in Win32-style path or paths like 'D:/../c/' |
| 441 | # will be resolved incorrectly. |
| 442 | # Replace any possible back slashes with forward slashes, |
| 443 | # remove any duplicated slashes. |
| 444 | $path = get_abs_path_on_win32_drive($1, $2); |
| 445 | return undef unless defined $path; |
| 446 | |
| 447 | return simple_transform_win32_to_unix($path); |
| 448 | } |
| 449 | elsif($path eq '') { |
| 450 | # Path is empty string. Return current directory. |
| 451 | # Empty string processed correctly by 'cygpath'. |
| 452 | |
| 453 | # MSys shell has built-in command. |
| 454 | if($^O eq 'msys') { |
| 455 | chomp($path = `bash -c 'pwd -L'`); |
| 456 | } |
| 457 | else { |
| 458 | chomp($path = `pwd -L`); |
| 459 | } |
| 460 | if($? != 0) { |
| 461 | warn "Can't determine Unix-style current working directory.\n"; |
| 462 | return undef; |
| 463 | } |
| 464 | |
| 465 | # Add final slash if not at root dir. |
| 466 | $path .= '/' if length($path) > 2; |
| 467 | return $path; |
| 468 | } |
| 469 | elsif(should_use_cygpath()) { |
| 470 | # 'cygpath' is available - use it. |
| 471 | |
| 472 | my $has_final_slash = ($path =~ m{[\\/]$}); |
| 473 | |
| 474 | # Resolve relative directories, as they may be not resolved for |
| 475 | # Unix-style paths. |
| 476 | # Remove duplicated slashes, as they may be not processed. |
| 477 | $path = normalize_path($path); |
| 478 | return undef unless defined $path; |
| 479 | |
| 480 | # Use 'cygpath', '-u' means Unix-stile path, |
| 481 | # '-a' means absolute path |
| 482 | chomp($path = `cygpath -u -a '$path'`); |
| 483 | if($? != 0) { |
| 484 | warn "Can't resolve path by usung \"cygpath\".\n"; |
| 485 | return undef; |
| 486 | } |
| 487 | |
| 488 | # 'cygpath' removes last slash if path is root dir on Win32 drive. |
| 489 | # Restore it. |
| 490 | $path .= '/' if($has_final_slash && |
| 491 | substr($path, length($path) - 1, 1) ne '/'); |
| 492 | |
| 493 | return $path |
| 494 | } |
| 495 | elsif($path =~ m{^[a-zA-Z]:[/\\]}) { |
| 496 | # Path is already in Win32 form. ('C:\path') |
| 497 | |
| 498 | # Resolve relative dirs in Win32-style path otherwise paths |
| 499 | # like 'D:/../c/' will be resolved incorrectly. |
| 500 | # Replace any possible back slashes with forward slashes, |
| 501 | # remove any duplicated slashes. |
| 502 | $path = normalize_path($path); |
| 503 | return undef unless defined $path; |
| 504 | |
| 505 | return simple_transform_win32_to_unix($path); |
| 506 | } |
| 507 | elsif(substr($path, 0, 1) eq '\\') { |
| 508 | # Path is directory or filename on Win32 current drive. ('\Windows') |
| 509 | |
| 510 | my $w32drive = get_win32_current_drive(); |
| 511 | return undef unless defined $w32drive; |
| 512 | |
| 513 | # Combine drive and path. |
| 514 | # Resolve relative dirs in Win32-style path or paths like 'D:/../c/' |
| 515 | # will be resolved incorrectly. |
| 516 | # Replace any possible back slashes with forward slashes, |
| 517 | # remove any duplicated slashes. |
| 518 | $path = normalize_path($w32drive . $path); |
| 519 | return undef unless defined $path; |
| 520 | |
| 521 | return simple_transform_win32_to_unix($path); |
| 522 | } |
| 523 | |
| 524 | # Path is not in any Win32 form. |
| 525 | unless (substr($path, 0, 1) eq '/') { |
| 526 | # Path in relative form. Resolve relative directories in Unix form |
| 527 | # *BEFORE* converting to Win32 form otherwise paths like |
| 528 | # '../../../cygdrive/c/windows' will not be resolved. |
| 529 | |
| 530 | my $cur_dir; |
| 531 | # MSys shell has built-in command. |
| 532 | if($^O eq 'msys') { |
| 533 | $cur_dir = `bash -c 'pwd -L'`; |
| 534 | } |
| 535 | else { |
| 536 | $cur_dir = `pwd -L`; |
| 537 | } |
| 538 | if($? != 0) { |
| 539 | warn "Can't determine current working directory.\n"; |
| 540 | return undef; |
| 541 | } |
| 542 | chomp($cur_dir); |
| 543 | |
| 544 | $path = $cur_dir . '/' . $path; |
| 545 | } |
| 546 | |
| 547 | return normalize_path($path); |
| 548 | } |
| 549 | |
| 550 | ####################################################################### |
| 551 | # Performs path "normalization": all slashes converted to forward |
| 552 | # slashes (except leading slash), all duplicated slashes are replaced |
| 553 | # with single slashes, all relative directories ('./' and '../') are |
| 554 | # resolved if possible. |
| 555 | # Path processed as string, directories are not checked for presence so |
| 556 | # path for not yet existing directory can be "normalized". |
| 557 | # |
| 558 | sub normalize_path { |
| 559 | my ($path) = @_; |
| 560 | |
| 561 | # Don't process empty paths. |
| 562 | return $path if $path eq ''; |
| 563 | |
| 564 | unless($path =~ m{(?:^|\\|/)\.{1,2}(?:\\|/|$)}) { |
| 565 | # Speed up processing of simple paths. |
| 566 | my $first_char = substr($path, 0, 1); |
| 567 | $path =~ s{[\\/]+}{/}g; |
| 568 | # Restore starting backslash if any. |
| 569 | substr($path, 0, 1) = $first_char; |
| 570 | return $path; |
| 571 | } |
| 572 | |
| 573 | my @arr; |
| 574 | my $prefix; |
| 575 | my $have_root = 0; |
| 576 | |
| 577 | # Check whether path starts from Win32 drive. ('C:path' or 'C:\path') |
| 578 | if($path =~ m{^([a-zA-Z]:(/|\\)?)(.*$)}) { |
| 579 | $prefix = $1; |
| 580 | $have_root = 1 if defined $2; |
| 581 | # Process path separately from drive letter. |
| 582 | @arr = split(m{\/|\\}, $3); |
| 583 | # Replace backslash with forward slash if required. |
| 584 | substr($prefix, 2, 1) = '/' if $have_root; |
| 585 | } |
| 586 | else { |
| 587 | if($path =~ m{^(\/|\\)}) { |
| 588 | $have_root = 1; |
| 589 | $prefix = $1; |
| 590 | } |
| 591 | else { |
| 592 | $prefix = ''; |
| 593 | } |
| 594 | @arr = split(m{\/|\\}, $path); |
| 595 | } |
| 596 | |
| 597 | my $p = 0; |
| 598 | my @res; |
| 599 | |
| 600 | for my $el (@arr) { |
| 601 | if(length($el) == 0 || $el eq '.') { |
| 602 | next; |
| 603 | } |
| 604 | elsif($el eq '..' && @res > 0 && $res[$#res] ne '..') { |
| 605 | pop @res; |
| 606 | next; |
| 607 | } |
| 608 | push @res, $el; |
| 609 | } |
| 610 | if($have_root && @res > 0 && $res[0] eq '..') { |
| 611 | warn "Error processing path \"$path\": " . |
| 612 | "Parent directory of root directory does not exist!\n"; |
| 613 | return undef; |
| 614 | } |
| 615 | |
| 616 | my $ret = $prefix . join('/', @res); |
| 617 | $ret .= '/' if($path =~ m{\\$|/$} && scalar @res > 0); |
| 618 | |
| 619 | return $ret; |
| 620 | } |
| 621 | |
| 622 | # Internal function. Converts path by using Msys's built-in |
| 623 | # transformation. |
| 624 | sub do_msys_transform { |
| 625 | my ($path) = @_; |
| 626 | return undef if $^O ne 'msys'; |
| 627 | return $path if $path eq ''; |
| 628 | |
| 629 | # Remove leading double forward slashes, as they turn off Msys |
| 630 | # transforming. |
| 631 | $path =~ s{^/[/\\]+}{/}; |
| 632 | |
| 633 | # Msys transforms automatically path to Windows native form in staring |
| 634 | # program parameters if program is not Msys-based. |
| 635 | # Note: already checked that $path is non-empty. |
| 636 | $path = `cmd //c echo '$path'`; |
| 637 | if($? != 0) { |
| 638 | warn "Can't transform path into Win32 form by using Msys" . |
| 639 | "internal transformation.\n"; |
| 640 | return undef; |
| 641 | } |
| 642 | |
| 643 | # Remove double quotes, they are added for paths with spaces, |
| 644 | # remove both '\r' and '\n'. |
| 645 | $path =~ s{^\"|\"$|\"\r|\n|\r}{}g; |
| 646 | |
| 647 | return $path; |
| 648 | } |
| 649 | |
| 650 | # Internal function. Gets two parameters: first parameter must be single |
| 651 | # drive letter ('c'), second optional parameter is path relative to drive's |
| 652 | # current working directory. Returns Win32 absolute normalized path. |
| 653 | sub get_abs_path_on_win32_drive { |
| 654 | my ($drv, $rel_path) = @_; |
| 655 | my $res; |
| 656 | |
| 657 | # Get current directory on specified drive. |
| 658 | # "/c;" is compatible with both Msys and Cygwin. |
| 659 | my $cur_dir_on_drv = `cmd "/c;" echo %=$drv:%`; |
| 660 | if($? != 0) { |
| 661 | warn "Can't determine Win32 current directory on drive $drv:.\n"; |
| 662 | return undef; |
| 663 | } |
| 664 | |
| 665 | if($cur_dir_on_drv =~ m{^[%]}) { |
| 666 | # Current directory on drive is not set, default is |
| 667 | # root directory. |
| 668 | |
| 669 | $res = ucfirst($drv) . ':/'; |
| 670 | } |
| 671 | else { |
| 672 | # Current directory on drive was set. |
| 673 | # Remove both '\r' and '\n'. |
| 674 | $cur_dir_on_drv =~ s{\n|\r}{}g; |
| 675 | |
| 676 | # Append relative path part. |
| 677 | $res = $cur_dir_on_drv . '/'; |
| 678 | } |
| 679 | $res .= $rel_path if defined $rel_path; |
| 680 | |
| 681 | # Replace any possible back slashes with forward slashes, |
| 682 | # remove any duplicated slashes, resolve relative dirs. |
| 683 | return normalize_path($res); |
| 684 | } |
| 685 | |
| 686 | # Internal function. Tries to find or guess Win32 version of given |
| 687 | # absolute Unix-style path. Other types of paths are not supported. |
| 688 | # Returned paths contain only single forward slashes (no back and |
| 689 | # duplicated slashes). |
| 690 | # Last resort. Used only when other transformations are not available. |
| 691 | sub do_dumb_guessed_transform { |
| 692 | my ($path) = @_; |
| 693 | |
| 694 | # Replace any possible back slashes and duplicated forward slashes |
| 695 | # with single forward slashes. |
| 696 | $path =~ s{[/\\]+}{/}g; |
| 697 | |
| 698 | # Empty path is not valid. |
| 699 | return undef if (length($path) == 0); |
| 700 | |
| 701 | # RE to find Win32 drive letter |
| 702 | my $drv_ltr_re = drives_mounted_on_cygdrive() ? |
| 703 | qr{^/cygdrive/([a-zA-Z])($|/.*$)} : |
| 704 | qr{^/([a-zA-Z])($|/.*$)}; |
| 705 | |
| 706 | # Check path whether path is Win32 directly mapped drive and try to |
| 707 | # transform it assuming that drive letter is matched to Win32 drive letter. |
| 708 | if($path =~ m{$drv_ltr_re}) { |
| 709 | return ucfirst($1) . ':/' if(length($2) == 0); |
| 710 | return ucfirst($1) . ':' . $2; |
| 711 | } |
| 712 | |
| 713 | # This may be some custom mapped path. ('/mymount/path') |
| 714 | |
| 715 | # Must check longest possible path component as subdir can be mapped to |
| 716 | # different directory. For example '/usr/bin/' can be mapped to '/bin/' or |
| 717 | # '/bin/' can be mapped to '/usr/bin/'. |
| 718 | my $check_path = $path; |
| 719 | my $path_tail = ''; |
| 720 | do { |
| 721 | if(-d $check_path) { |
| 722 | my $res = |
| 723 | `(cd "$check_path" && cmd /c "echo %__CD__%") 2>/dev/null`; |
| 724 | if($? == 0 && substr($path, 0, 1) ne '%') { |
| 725 | # Remove both '\r' and '\n'. |
| 726 | $res =~ s{\n|\r}{}g; |
| 727 | |
| 728 | # Replace all back slashes with forward slashes. |
| 729 | $res =~ s{\\}{/}g; |
| 730 | |
| 731 | if(length($path_tail) > 0) { |
| 732 | return $res . $path_tail; |
| 733 | } |
| 734 | else { |
| 735 | $res =~ s{/$}{} unless $check_path =~ m{/$}; |
| 736 | return $res; |
| 737 | } |
| 738 | } |
| 739 | } |
| 740 | if($check_path =~ m{(^.*/)([^/]+/*)}) { |
| 741 | $check_path = $1; |
| 742 | $path_tail = $2 . $path_tail; |
| 743 | } |
| 744 | else { |
| 745 | # Shouldn't happens as root '/' directory should always |
| 746 | # be resolvable. |
| 747 | warn "Can't determine Win32 directory for path \"$path\".\n"; |
| 748 | return undef; |
| 749 | } |
| 750 | } while(1); |
| 751 | } |
| 752 | |
| 753 | |
| 754 | # Internal function. Converts given Unix-style absolute path to Win32 format. |
| 755 | sub simple_transform_win32_to_unix { |
| 756 | my ($path) = @_; |
| 757 | |
| 758 | if(should_use_cygpath()) { |
| 759 | # 'cygpath' gives precise result. |
| 760 | my $res; |
| 761 | chomp($res = `cygpath -a -u '$path'`); |
| 762 | if($? != 0) { |
| 763 | warn "Can't determine Unix-style directory for Win32 " . |
| 764 | "directory \"$path\".\n"; |
| 765 | return undef; |
| 766 | } |
| 767 | |
| 768 | # 'cygpath' removes last slash if path is root dir on Win32 drive. |
| 769 | $res .= '/' if(substr($res, length($res) - 1, 1) ne '/' && |
| 770 | $path =~ m{[/\\]$}); |
| 771 | return $res; |
| 772 | } |
| 773 | |
| 774 | # 'cygpath' is not available, use guessed transformation. |
| 775 | unless($path =~ s{^([a-zA-Z]):(?:/|\\)}{/\l$1/}) { |
| 776 | warn "Can't determine Unix-style directory for Win32 " . |
| 777 | "directory \"$path\".\n"; |
| 778 | return undef; |
| 779 | } |
| 780 | |
| 781 | $path = '/cygdrive' . $path if(drives_mounted_on_cygdrive()); |
| 782 | return $path; |
| 783 | } |
| 784 | |
| 785 | 1; # End of module |