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