[PATCH] Use short pathnames in $^X and @INC if the long form cannot be represented in the current codepage

Date: Thu, 28 Dec 2006 18:59:40 -0800
Message-ID: <vq09p2p09k6rcu6c9t0mab3vnc335ghg9m@4ax.com>

Subject: Re: [PATCH] Use short pathnames in $^X and @INC if the long form cannot be represented in the current codepage
From: Jan Dubois <jand@ActiveState.com>
Date: Wed, 03 Jan 2007 08:12:35 -0800
Message-ID: <orknp2pj17265modfosjkp2qtt4bdgtgjp@4ax.com>

p4raw-id: //depot/perl@29675

6 files changed, 131 insertions, 60 deletions

diff --git a/makedef.pl b/makedef.pl
index e181e5f7e1..a839855e80 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -1296,6 +1296,7 @@ if ($PLATFORM =~ /^win(?:32|ce)$/) {
 			    win32_rewinddir
 			    win32_closedir
 			    win32_longpath
+			    win32_ansipath
 			    win32_os_id
 			    win32_getpid
 			    win32_crypt
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 3860507be6..e042103719 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -2238,32 +2238,6 @@ CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
     Safefree(lpStr);
 }
 
-static char *
-get_valid_filename(pTHX_ WCHAR *widename)
-{
-    char *name;
-    BOOL use_default = FALSE;
-    size_t widelen = wcslen(widename)+1;
-    int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
-                                  NULL, 0, NULL, NULL);
-    Newx(name, len, char);
-    WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
-                        name, len, NULL, &use_default);
-    if (use_default) {
-        WCHAR *shortname;
-        DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
-        Newx(shortname, shortlen, WCHAR);
-        shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
-        len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
-                                  NULL, 0, NULL, NULL);
-        Renew(name, len, char);
-        WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
-                            name, len, NULL, NULL);
-        Safefree(shortname);
-    }
-    return name;
-}
-
 char*
 CPerlHost::GetChildDir(void)
 {
@@ -2271,15 +2245,8 @@ CPerlHost::GetChildDir(void)
     char* ptr;
     size_t length;
 
-    if (IsWin95()) {
-        Newx(ptr, MAX_PATH+1, char);
-        m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
-    }
-    else {
-        WCHAR path[MAX_PATH+1];
-        m_pvDir->GetCurrentDirectoryW(MAX_PATH+1, path);
-        ptr = get_valid_filename(aTHX_ path);
-    }
+    Newx(ptr, MAX_PATH+1, char);
+    m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
     length = strlen(ptr);
     if (length > 3) {
         if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
diff --git a/win32/perllib.c b/win32/perllib.c
index 1e4ba09001..9b488d190f 100644
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -207,17 +207,24 @@ RunPerl(int argc, char **argv, char **env)
 {
     int exitstatus;
     PerlInterpreter *my_perl, *new_perl = NULL;
-
-#ifndef __BORLANDC__
-    /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
-     * want to free() argv after main() returns.  As luck would have it,
-     * Borland's CRT does the right thing to argv[0] already. */
+    OSVERSIONINFO osver;
     char szModuleName[MAX_PATH];
+    char *arg0 = argv[0];
+    char *ansi = NULL;
 
-    Win_GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
-    (void)win32_longpath(szModuleName);
-    argv[0] = szModuleName;
-#endif
+    osver.dwOSVersionInfoSize = sizeof(osver);
+    GetVersionEx(&osver);
+
+    if (osver.dwPlatformId == VER_PLATFORM_WIN32_NT) {
+        WCHAR widename[MAX_PATH];
+        GetModuleFileNameW(NULL, widename, sizeof(widename)/sizeof(WCHAR));
+        argv[0] = ansi = win32_ansipath(widename);
+    }
+    else {
+        Win_GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
+        (void)win32_longpath(szModuleName);
+        argv[0] = szModuleName;
+    }
 
 #ifdef PERL_GLOBAL_STRUCT
 #define PERLVAR(var,type) /**/
@@ -259,6 +266,11 @@ RunPerl(int argc, char **argv, char **env)
     }
 #endif
 
+    /* At least the Borland RTL wants to free argv[] after main() returns. */
+    argv[0] = arg0;
+    if (ansi)
+        win32_free(ansi);
+
     PERL_SYS_TERM();
 
     return (exitstatus);
diff --git a/win32/vdir.h b/win32/vdir.h
index fb80e38679..fb93205408 100644
--- a/win32/vdir.h
+++ b/win32/vdir.h
@@ -261,13 +261,13 @@ void VDir::SetDefaultA(char const *pDefault)
 int VDir::SetDirW(WCHAR const *pPath, int index)
 {
     WCHAR chr, *ptr;
-    char szBuffer[MAX_PATH+1];
     int length = 0;
     if (index < driveCount && pPath != NULL) {
 	length = wcslen(pPath);
 	pMem->Free(dirTableW[index]);
 	ptr = dirTableW[index] = (WCHAR*)pMem->Malloc((length+2)*2);
 	if (ptr != NULL) {
+            char *ansi;
 	    wcscpy(ptr, pPath);
 	    ptr += length-1;
 	    chr = *ptr++;
@@ -275,13 +275,14 @@ int VDir::SetDirW(WCHAR const *pPath, int index)
 		*ptr++ = '\\';
 		*ptr = '\0';
 	    }
-	    WideCharToMultiByte(CP_ACP, 0, dirTableW[index], -1, szBuffer, sizeof(szBuffer), NULL, NULL);
-	    length = strlen(szBuffer);
+            ansi = win32_ansipath(dirTableW[index]);
+	    length = strlen(ansi);
 	    pMem->Free(dirTableA[index]);
 	    dirTableA[index] = (char*)pMem->Malloc(length+1);
 	    if (dirTableA[index] != NULL) {
-		strcpy(dirTableA[index], szBuffer);
+		strcpy(dirTableA[index], ansi);
 	    }
+            win32_free(ansi);
 	}
     }
 
diff --git a/win32/win32.c b/win32/win32.c
index 948aa257d2..01621274f0 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -194,21 +194,48 @@ IsWinNT(void)
 EXTERN_C void
 set_w32_module_name(void)
 {
+    /* this function may be called at DLL_PROCESS_ATTACH time */
     char* ptr;
-    GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
-				? GetModuleHandle(NULL)
-				: w32_perldll_handle),
-		      w32_module_name, sizeof(w32_module_name));
+    HMODULE module = (HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
+                               ? GetModuleHandle(NULL)
+                               : w32_perldll_handle);
 
-    /* remove \\?\ prefix */
-    if (memcmp(w32_module_name, "\\\\?\\", 4) == 0)
-        memmove(w32_module_name, w32_module_name+4, strlen(w32_module_name+4)+1);
+    OSVERSIONINFO osver; /* g_osver may not yet be initialized */
+    osver.dwOSVersionInfoSize = sizeof(osver);
+    GetVersionEx(&osver);
 
-    /* try to get full path to binary (which may be mangled when perl is
-     * run from a 16-bit app) */
-    /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/
-    (void)win32_longpath(w32_module_name);
-    /*PerlIO_printf(Perl_debug_log, "After  %s\n", w32_module_name);*/
+    if (osver.dwPlatformId == VER_PLATFORM_WIN32_NT) {
+        WCHAR modulename[MAX_PATH];
+        WCHAR fullname[MAX_PATH];
+        char *ansi;
+
+        GetModuleFileNameW(module, modulename, sizeof(modulename)/sizeof(WCHAR));
+
+        /* Make sure we get an absolute pathname in case the module was loaded
+         * explicitly by LoadLibrary() with a relative path. */
+        GetFullPathNameW(modulename, sizeof(fullname)/sizeof(WCHAR), fullname, NULL);
+
+        /* remove \\?\ prefix */
+        if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
+            memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));
+
+        ansi = win32_ansipath(fullname);
+        my_strlcpy(w32_module_name, ansi, sizeof(w32_module_name));
+        win32_free(ansi);
+    }
+    else {
+        GetModuleFileName(module, w32_module_name, sizeof(w32_module_name));
+
+        /* remove \\?\ prefix */
+        if (memcmp(w32_module_name, "\\\\?\\", 4) == 0)
+            memmove(w32_module_name, w32_module_name+4, strlen(w32_module_name+4)+1);
+
+        /* try to get full path to binary (which may be mangled when perl is
+         * run from a 16-bit app) */
+        /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/
+        win32_longpath(w32_module_name);
+        /*PerlIO_printf(Perl_debug_log, "After  %s\n", w32_module_name);*/
+    }
 
     /* normalize to forward slashes */
     ptr = w32_module_name;
@@ -1586,6 +1613,67 @@ win32_longpath(char *path)
     return path;
 }
 
+static void
+out_of_memory()
+{
+    dTHX;
+    /* Can't use PerlIO to write as it allocates memory */
+    PerlLIO_write(PerlIO_fileno(Perl_error_log),
+                  PL_no_mem, strlen(PL_no_mem));
+    my_exit(1);
+}
+
+/* The win32_ansipath() function takes a Unicode filename and converts it
+ * into the current Windows codepage. If some characters cannot be mapped,
+ * then it will convert the short name instead.
+ *
+ * The buffer to the ansi pathname must be freed with win32_free() when it
+ * it no longer needed.
+ *
+ * The argument to win32_ansipath() must exist before this function is
+ * called; otherwise there is no way to determine the short path name.
+ *
+ * Ideas for future refinement:
+ * - Only convert those segments of the path that are not in the current
+ *   codepage, but leave the other segments in their long form.
+ * - If the resulting name is longer than MAX_PATH, start converting
+ *   additional path segments into short names until the full name
+ *   is shorter than MAX_PATH.  Shorten the filename part last!
+ */
+DllExport char *
+win32_ansipath(const WCHAR *widename)
+{
+    char *name;
+    BOOL use_default = FALSE;
+    size_t widelen = wcslen(widename)+1;
+    int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
+                                  NULL, 0, NULL, NULL);
+    name = win32_malloc(len);
+    if (!name)
+        out_of_memory();
+
+    WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
+                        name, len, NULL, &use_default);
+    if (use_default) {
+        WCHAR *shortname;
+        DWORD shortlen = GetShortPathNameW(widename, NULL, 0);
+        shortname = win32_malloc(shortlen*sizeof(WCHAR));
+        if (!shortname)
+            out_of_memory();
+        shortlen = GetShortPathNameW(widename, shortname, shortlen)+1;
+
+        len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
+                                  NULL, 0, NULL, NULL);
+        name = win32_realloc(name, len);
+        if (!name)
+            out_of_memory();
+        WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, shortname, shortlen,
+                            name, len, NULL, NULL);
+        win32_free(shortname);
+    }
+    return name;
+}
+
 DllExport char *
 win32_getenv(const char *name)
 {
diff --git a/win32/win32iop.h b/win32/win32iop.h
index fd0f95890f..b03e9a753c 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -132,6 +132,7 @@ DllExport  int		win32_times(struct tms *timebuf);
 DllExport  unsigned 	win32_alarm(unsigned int sec);
 DllExport  int		win32_stat(const char *path, Stat_t *buf);
 DllExport  char*	win32_longpath(char *path);
+DllExport  char*	win32_ansipath(const WCHAR *path);
 DllExport  int		win32_ioctl(int i, unsigned int u, char *data);
 DllExport  int          win32_link(const char *oldname, const char *newname);
 DllExport  int		win32_unlink(const char *f);
@@ -239,6 +240,7 @@ END_EXTERN_C
 #define fstat(fd,bufptr)   	win32_fstat(fd,bufptr)
 #define stat(pth,bufptr)   	win32_stat(pth,bufptr)
 #define longpath(pth)   	win32_longpath(pth)
+#define ansipath(pth)   	win32_ansipath(pth)
 #define rename(old,new)		win32_rename(old,new)
 #define setmode(fd,mode)	win32_setmode(fd,mode)
 #define chsize(fd,sz)		win32_chsize(fd,sz)