1 #!/bin/perl |
|
2 |
|
3 # |
|
4 # Copyright (c) 2012, Oracle and/or its affiliates. All rights reserved. |
|
5 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. |
|
6 # |
|
7 # This code is free software; you can redistribute it and/or modify it |
|
8 # under the terms of the GNU General Public License version 2 only, as |
|
9 # published by the Free Software Foundation. Oracle designates this |
|
10 # particular file as subject to the "Classpath" exception as provided |
|
11 # by Oracle in the LICENSE file that accompanied this code. |
|
12 # |
|
13 # This code is distributed in the hope that it will be useful, but WITHOUT |
|
14 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
15 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
16 # version 2 for more details (a copy is included in the LICENSE file that |
|
17 # accompanied this code). |
|
18 # |
|
19 # You should have received a copy of the GNU General Public License version |
|
20 # 2 along with this work; if not, write to the Free Software Foundation, |
|
21 # Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. |
|
22 # |
|
23 # Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA |
|
24 # or visit www.oracle.com if you need additional information or have any |
|
25 # questions. |
|
26 # |
|
27 |
|
28 # Crunch down the input(s) to Windows short (mangled) form. |
|
29 # Any elements not actually found in the filesystem will be dropped. |
|
30 # |
|
31 # This script needs three modes: |
|
32 # 1) DOS mode with drive letter followed by : and ; path separator |
|
33 # 2) Cygwin mode with /cygdrive/<drive letter>/ and : path separator |
|
34 # 3) MinGW/MSYS mode with /<drive letter>/ and : path separator |
|
35 |
|
36 use strict; |
|
37 use warnings; |
|
38 use Getopt::Std; |
|
39 |
|
40 sub Usage() { |
|
41 print ("Usage:\n $0 -d | -c | -m \<PATH\>\n"); |
|
42 print (" -d DOS style (drive letter, :, and ; path separator)\n"); |
|
43 print (" -c Cywgin style (/cygdrive/drive/ and : path separator)\n"); |
|
44 print (" -m MinGW style (/drive/ and : path separator)\n"); |
|
45 exit 1; |
|
46 } |
|
47 # Process command line options: |
|
48 my %opts; |
|
49 getopts('dcm', \%opts) || Usage(); |
|
50 |
|
51 if (scalar(@ARGV) != 1) {Usage()}; |
|
52 |
|
53 # Translate drive letters such as C:/ |
|
54 # if MSDOS, Win32::GetShortPathName() does the work (see below). |
|
55 # if Cygwin, use the /cygdrive/c/ form. |
|
56 # if MinGW, use the /c/ form. |
|
57 my $path0; |
|
58 my $sep2; |
|
59 if (defined ($opts{'d'})) { |
|
60 #MSDOS |
|
61 $path0 = ''; |
|
62 $sep2 = ';'; |
|
63 } elsif (defined ($opts{'c'})) { |
|
64 #Cygwin |
|
65 $path0 = '/cygdrive'; |
|
66 $sep2 = ':'; |
|
67 } elsif (defined ($opts{'m'})) { |
|
68 #MinGW/MSYS |
|
69 $path0 = ''; |
|
70 $sep2 = ':'; |
|
71 } else { |
|
72 Usage(); |
|
73 } |
|
74 |
|
75 my $input = $ARGV[0]; |
|
76 my $sep1; |
|
77 |
|
78 # Is the input ';' separated, or ':' separated, or a simple string? |
|
79 if (($input =~ tr/;/;/) > 0) { |
|
80 # One or more ';' implies Windows style path. |
|
81 $sep1 = ';'; |
|
82 } elsif (($input =~ tr/:/:/) > 1) { |
|
83 # Two or more ':' implies Cygwin or MinGW/MSYS style path. |
|
84 $sep1 = ':'; |
|
85 } else { |
|
86 # Otherwise, this is not a path - take up to the end of string in |
|
87 # one piece. |
|
88 $sep1 = '/$/'; |
|
89 } |
|
90 |
|
91 # Split the input on $sep1 PATH separator and process the pieces. |
|
92 my @pieces; |
|
93 for (split($sep1, $input)) { |
|
94 my $try = $_; |
|
95 |
|
96 if (($try =~ /^\/cygdrive\/(.)\/(.*)$/) || ($try =~ /^\/(.)\/(.*)$/)) { |
|
97 # Special case #1: This is a Cygwin /cygrive/<drive letter/ path. |
|
98 # Special case #2: This is a MinGW/MSYS /<drive letter/ path. |
|
99 $try = $1.':/'.$2; |
|
100 } elsif ($try =~ /^\/(.*)$/) { |
|
101 # Special case #3: check for a Cygwin or MinGW/MSYS form with a |
|
102 # leading '/' for example '/usr/bin/bash'. |
|
103 # Look up where this is mounted and rebuild the |
|
104 # $try string with that information |
|
105 my $cmd = "df --portability --all --human-readable $try"; |
|
106 my $line = qx ($cmd); |
|
107 my $status = $?; |
|
108 if ($status == 0) { |
|
109 my @lines = split ('\n', $line); |
|
110 my ($device, $junk, $mountpoint); |
|
111 # $lines[0] is the df header. |
|
112 # Example string for split - we want the first and last elements: |
|
113 # C:\jprt\products\P1\MinGW\msys\1.0 200G 78G 123G 39% /usr |
|
114 ($device, $junk, $junk, $junk, $junk, $mountpoint) = split (/\s+/, $lines[1]); |
|
115 # Replace $mountpoint with $device/ in the original string |
|
116 $try =~ s|$mountpoint|$device/|; |
|
117 } else { |
|
118 printf ("Error %d from command %s\n%s\n", $status, $cmd, $line); |
|
119 } |
|
120 } |
|
121 |
|
122 my $str = Win32::GetShortPathName($try); |
|
123 if (!defined($str)){ |
|
124 # Special case #4: If the lookup did not work, loop through |
|
125 # adding extensions listed in PATHEXT, looking for the first |
|
126 # match. |
|
127 for (split(';', $ENV{'PATHEXT'})) { |
|
128 $str = Win32::GetShortPathName($try.$_); |
|
129 if (defined($str)) { |
|
130 last; |
|
131 } |
|
132 } |
|
133 } |
|
134 |
|
135 if (defined($str)){ |
|
136 if (!defined($opts{'d'})) { |
|
137 # If not MSDOS, change C: to [/cygdrive]/c/ |
|
138 if ($str =~ /^(\S):(.*)$/) { |
|
139 my $path1 = $1; |
|
140 my $path2 = $2; |
|
141 $str = $path0 . '/' . $path1 . '/' . $path2; |
|
142 } |
|
143 } |
|
144 push (@pieces, $str); |
|
145 } |
|
146 } |
|
147 |
|
148 # If input was a PATH, join the pieces back together with $sep2 path |
|
149 # separator. |
|
150 my $result; |
|
151 if (scalar(@pieces > 1)) { |
|
152 $result = join ($sep2, @pieces); |
|
153 } else { |
|
154 $result = $pieces[0]; |
|
155 } |
|
156 |
|
157 if (defined ($result)) { |
|
158 |
|
159 # Change all '\' to '/' |
|
160 $result =~ s/\\/\//g; |
|
161 |
|
162 # Remove duplicate '/' |
|
163 $result =~ s/\/\//\//g; |
|
164 |
|
165 # Map to lower case |
|
166 $result =~ tr/A-Z/a-z/; |
|
167 |
|
168 print ("$result\n"); |
|
169 } |
|