On Windows normalize $^X using GetLongPathName()

If perl.exe is called with a short pathname, then GetModuleFileName()
will return this short name, and $^X will be set to it.  This in turn
is used to initialize @INC to privlib, sitelib and vendorlib locations
relative to $^X, so they too will end up with the mangled short names.

Perl will also automatically add versioned Perl directories in the
same tree if their names start with the same major and minor Perl
version numbers.  This heuristic can be broken when the pathname
components are using short pathnames.  Therefore $^X and @INC should
all be normalized to use the long pathname format.

See also http://rt.cpan.org/Public/Bug/Display.html?id=47890

diff --git a/win32/win32.c b/win32/win32.c
index 2397f5c..be8fa5a 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -226,12 +226,24 @@ set_w32_module_name(void)
         WCHAR fullname[MAX_PATH];
         char *ansi;
 
+        DWORD (__stdcall *pfnGetLongPathNameW)(LPCWSTR, LPWSTR, DWORD) =
+            (DWORD (__stdcall *)(LPCWSTR, LPWSTR, DWORD))
+            GetProcAddress(GetModuleHandle("kernel32.dll"), "GetLongPathNameW");
+
         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);
 
+        /* Make sure we start with the long path name of the module because we
+         * later scan for pathname components to match "5.xx" to locate
+         * compatible sitelib directories, and the short pathname might mangle
+         * this path segment (e.g. by removing the dot on NTFS to something
+         * like "5xx~1.yy") */
+        if (pfnGetLongPathNameW)
+            pfnGetLongPathNameW(fullname, fullname, sizeof(fullname)/sizeof(WCHAR));
+
         /* remove \\?\ prefix */
         if (memcmp(fullname, L"\\\\?\\", 4*sizeof(WCHAR)) == 0)
             memmove(fullname, fullname+4, (wcslen(fullname+4)+1)*sizeof(WCHAR));