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