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