Mercurial > jdk8-mips64-public / file revision

 #!/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");

 }