tests/pathhelp.pm

   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
  51 package pathhelp;
  52 use strict;
  53 use warnings;
  54 use Cwd 'abs_path';
  55
  56 BEGIN {
  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
 103 our $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.
 109 sub 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 #
 129 sub normalize_path;
 130
 131 #######################################################################
 132 # Returns current working directory in Win32 format on Windows.
 133 #
 134 sub 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 #
 167 sub 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.
 181 sub 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.
 186 sub 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.
 193 sub 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 #
 200 sub 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 #
 301 sub 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.
 406 sub 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 #
 413 sub 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 avalable - 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 #
 534 sub 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.
 600 sub 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.
 629 sub 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.
 667 sub 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.
 731 sub 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
 761 1;    # End of module