diff options
Diffstat (limited to 'make/scripts/fixpath.pl')
| -rw-r--r-- | make/scripts/fixpath.pl | 169 |
1 files changed, 169 insertions, 0 deletions
diff --git a/make/scripts/fixpath.pl b/make/scripts/fixpath.pl new file mode 100644 index 0000000..36ec981 --- /dev/null +++ b/make/scripts/fixpath.pl @@ -0,0 +1,169 @@ +#!/bin/perl + +# +# Copyright (c) 2012, Oracle and/or its affiliates. All rights reserved. +# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +# +# This code is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License version 2 only, as +# published by the Free Software Foundation. Oracle designates this +# particular file as subject to the "Classpath" exception as provided +# by Oracle in the LICENSE file that accompanied this code. +# +# This code is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# version 2 for more details (a copy is included in the LICENSE file that +# accompanied this code). +# +# You should have received a copy of the GNU General Public License version +# 2 along with this work; if not, write to the Free Software Foundation, +# Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. +# +# Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA +# or visit www.oracle.com if you need additional information or have any +# questions. +# + +# Crunch down the input(s) to Windows short (mangled) form. +# Any elements not actually found in the filesystem will be dropped. +# +# This script needs three modes: +# 1) DOS mode with drive letter followed by : and ; path separator +# 2) Cygwin mode with /cygdrive/<drive letter>/ and : path separator +# 3) MinGW/MSYS mode with /<drive letter>/ and : path separator + +use strict; +use warnings; +use Getopt::Std; + +sub Usage() { + print ("Usage:\n $0 -d | -c | -m \<PATH\>\n"); + print (" -d DOS style (drive letter, :, and ; path separator)\n"); + print (" -c Cywgin style (/cygdrive/drive/ and : path separator)\n"); + print (" -m MinGW style (/drive/ and : path separator)\n"); + exit 1; +} +# Process command line options: +my %opts; +getopts('dcm', \%opts) || Usage(); + +if (scalar(@ARGV) != 1) {Usage()}; + +# Translate drive letters such as C:/ +# if MSDOS, Win32::GetShortPathName() does the work (see below). +# if Cygwin, use the /cygdrive/c/ form. +# if MinGW, use the /c/ form. +my $path0; +my $sep2; +if (defined ($opts{'d'})) { + #MSDOS + $path0 = ''; + $sep2 = ';'; +} elsif (defined ($opts{'c'})) { + #Cygwin + $path0 = '/cygdrive'; + $sep2 = ':'; +} elsif (defined ($opts{'m'})) { + #MinGW/MSYS + $path0 = ''; + $sep2 = ':'; +} else { + Usage(); +} + +my $input = $ARGV[0]; +my $sep1; + +# Is the input ';' separated, or ':' separated, or a simple string? +if (($input =~ tr/;/;/) > 0) { + # One or more ';' implies Windows style path. + $sep1 = ';'; +} elsif (($input =~ tr/:/:/) > 1) { + # Two or more ':' implies Cygwin or MinGW/MSYS style path. + $sep1 = ':'; +} else { + # Otherwise, this is not a path - take up to the end of string in + # one piece. + $sep1 = '/$/'; +} + +# Split the input on $sep1 PATH separator and process the pieces. +my @pieces; +for (split($sep1, $input)) { + my $try = $_; + + if (($try =~ /^\/cygdrive\/(.)\/(.*)$/) || ($try =~ /^\/(.)\/(.*)$/)) { + # Special case #1: This is a Cygwin /cygrive/<drive letter/ path. + # Special case #2: This is a MinGW/MSYS /<drive letter/ path. + $try = $1.':/'.$2; + } elsif ($try =~ /^\/(.*)$/) { + # Special case #3: check for a Cygwin or MinGW/MSYS form with a + # leading '/' for example '/usr/bin/bash'. + # Look up where this is mounted and rebuild the + # $try string with that information + my $cmd = "df --portability --all --human-readable $try"; + my $line = qx ($cmd); + my $status = $?; + if ($status == 0) { + my @lines = split ('\n', $line); + my ($device, $junk, $mountpoint); + # $lines[0] is the df header. + # Example string for split - we want the first and last elements: + # C:\jprt\products\P1\MinGW\msys\1.0 200G 78G 123G 39% /usr + ($device, $junk, $junk, $junk, $junk, $mountpoint) = split (/\s+/, $lines[1]); + # Replace $mountpoint with $device/ in the original string + $try =~ s|$mountpoint|$device/|; + } else { + printf ("Error %d from command %s\n%s\n", $status, $cmd, $line); + } + } + + my $str = Win32::GetShortPathName($try); + if (!defined($str)){ + # Special case #4: If the lookup did not work, loop through + # adding extensions listed in PATHEXT, looking for the first + # match. + for (split(';', $ENV{'PATHEXT'})) { + $str = Win32::GetShortPathName($try.$_); + if (defined($str)) { + last; + } + } + } + + if (defined($str)){ + if (!defined($opts{'d'})) { + # If not MSDOS, change C: to [/cygdrive]/c/ + if ($str =~ /^(\S):(.*)$/) { + my $path1 = $1; + my $path2 = $2; + $str = $path0 . '/' . $path1 . '/' . $path2; + } + } + push (@pieces, $str); + } +} + +# If input was a PATH, join the pieces back together with $sep2 path +# separator. +my $result; +if (scalar(@pieces > 1)) { + $result = join ($sep2, @pieces); +} else { + $result = $pieces[0]; +} + +if (defined ($result)) { + + # Change all '\' to '/' + $result =~ s/\\/\//g; + + # Remove duplicate '/' + $result =~ s/\/\//\//g; + + # Map to lower case + $result =~ tr/A-Z/a-z/; + + print ("$result\n"); +} |