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# 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 53package pathhelp; 54use strict; 55use warnings; 56use Cwd 'abs_path'; 57 58BEGIN { 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 105our $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. 111sub 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# 131sub normalize_path; 132 133####################################################################### 134# Returns current working directory in Win32 format on Windows. 135# 136sub 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# 169sub 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. 183sub 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. 188sub 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. 195sub 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# 202sub 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# 303sub 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. 416sub 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# 423sub 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# 558sub 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. 624sub 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. 653sub 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. 691sub 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. 755sub 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 7851; # End of module 786