make/scripts/fixpath.pl
changeset 21759 e24e22311718
parent 21510 0b432ae58dd5
child 21760 9f542d8601a8
--- a/make/scripts/fixpath.pl	Thu Nov 07 08:16:05 2013 -0800
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,169 +0,0 @@
-#!/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");
-}