• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1###########################################################################
2#                                  _   _ ____  _
3#  Project                     ___| | | |  _ \| |
4#                             / __| | | | |_) | |
5#                            | (__| |_| |  _ <| |___
6#                             \___|\___/|_| \_\_____|
7#
8# Copyright (C) 2016 - 2020, 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