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