more bulletproof workaround for mangled paths (updates changes#3345,3350);

provide Win32::GetLongPathName() to complement Win32::GetShortPathName()

p4raw-link: @3350 on //depot/perl: b5ce6607ab4b332cfeb9911174599b4208a0bc29
p4raw-link: @3345 on //depot/perl: 95140b9803ddf95b050f1d52936f19393a6b541c

p4raw-id: //depot/perl@3353

diff --git a/t/op/magic.t b/t/op/magic.t
index 9b819a8..8486512 100755 (executable)
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -120,8 +120,9 @@ ok 18, $$ > 0, $$;
     $script = "$wd/show-shebang";
     if ($Is_MSWin32) {
        chomp($wd = `cd`);
-       $perl = "$wd\\perl.exe";
-       $script = "$wd\\show-shebang.bat";
+       $wd =~ s|\\|/|g;
+       $perl = "$wd/perl.exe";
+       $script = "$wd/show-shebang.bat";
        $headmaybe = <<EOH ;
 \@rem ='
 \@echo off

diff --git a/win32/makedef.pl b/win32/makedef.pl
index 0a753fb..f13c1da 100644 (file)
--- a/win32/makedef.pl
+++ b/win32/makedef.pl
@@ -462,6 +462,7 @@ win32_telldir
 win32_seekdir
 win32_rewinddir
 win32_closedir
+win32_longpath
 Perl_win32_init
 Perl_init_os_extras
 Perl_getTHR

diff --git a/win32/runperl.c b/win32/runperl.c
index 20423c7..1b569d2 100644 (file)
--- a/win32/runperl.c
+++ b/win32/runperl.c
@@ -44,8 +44,7 @@ main(int argc, char **argv, char **env)
     char *ptr;
 
     GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
-    (void)GetFullPathName(szModuleName, sizeof(szModuleName),
-                         szModuleName, &ptr);
+    (void)win32_longpath(szModuleName);
     argv[0] = szModuleName;
 #endif
 
@@ -93,8 +92,7 @@ main(int argc, char **argv, char **env)
     char *ptr;
 
     GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
-    (void)GetFullPathName(szModuleName, sizeof(szModuleName),
-                         szModuleName, &ptr);
+    (void)win32_longpath(szModuleName);
     argv[0] = szModuleName;
 #endif
     return RunPerl(argc, argv, env, (void*)0);

diff --git a/win32/win32.c b/win32/win32.c
index 5e54571..1e4e4c5 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -100,6 +100,7 @@ static long         find_pid(int pid);
 static char *          qualified_path(const char *cmd);
 
 HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
+char   w32_module_name[MAX_PATH+1];
 static DWORD   w32_platform = (DWORD)-1;
 
 #ifdef USE_THREADS
@@ -192,19 +193,27 @@ get_emd_part(char *prev_path, char *trailing_path, ...)
     sprintf(base, "%5.3f",
            (double)PERL_REVISION + ((double)PERL_VERSION / (double)1000));
 
-    GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
-                               ? GetModuleHandle(NULL) : w32_perldll_handle),
-                     mod_name, sizeof(mod_name));
-    /* try to get full path to binary (which may be mangled when perl is
-     * run from a 16-bit app */
-    (void)GetFullPathName(mod_name, sizeof(mod_name), mod_name, &ptr);
-    ptr = mod_name;
-    /* normalize to forward slashes */
-    while (*ptr) {
-       if (*ptr == '\\')
-           *ptr = '/';
-       ++ptr;
+    if (!*w32_module_name) {
+       GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
+                                   ? GetModuleHandle(NULL)
+                                   : w32_perldll_handle),
+                         w32_module_name, sizeof(w32_module_name));
+
+       /* try to get full path to binary (which may be mangled when perl is
+        * run from a 16-bit app) */
+       /*PerlIO_printf(PerlIO_stderr(), "Before %s\n", w32_module_name);*/
+       (void)win32_longpath(w32_module_name);
+       /*PerlIO_printf(PerlIO_stderr(), "After  %s\n", w32_module_name);*/
+
+       /* normalize to forward slashes */
+       ptr = w32_module_name;
+       while (*ptr) {
+           if (*ptr == '\\')
+               *ptr = '/';
+           ++ptr;
+       }
     }
+    strcpy(mod_name, w32_module_name);
     ptr = strrchr(mod_name, '/');
     while (ptr && strip) {
         /* look for directories to skip back */
@@ -979,6 +988,83 @@ win32_stat(const char *path, struct stat *buffer)
     return res;
 }
 
+/* Find the longname of a given path.  path is destructively modified.
+ * It should have space for at least MAX_PATH characters. */
+DllExport char *
+win32_longpath(char *path)
+{
+    WIN32_FIND_DATA fdata;
+    HANDLE fhand;
+    char tmpbuf[MAX_PATH+1];
+    char *tmpstart = tmpbuf;
+    char *start = path;
+    char sep;
+    if (!path)
+       return Nullch;
+
+    /* drive prefix */
+    if (isALPHA(path[0]) && path[1] == ':' &&
+       (path[2] == '/' || path[2] == '\\'))
+    {
+       start = path + 2;
+       *tmpstart++ = path[0];
+       *tmpstart++ = ':';
+    }
+    /* UNC prefix */
+    else if ((path[0] == '/' || path[0] == '\\') &&
+            (path[1] == '/' || path[1] == '\\'))
+    {
+       start = path + 2;
+       *tmpstart++ = '/';
+       *tmpstart++ = '/';
+       /* copy machine name */
+       while (*start && *start != '/' && *start != '\\')
+           *tmpstart++ = *start++;
+       if (*start) {
+           *tmpstart++ = '/';
+           start++;
+           /* copy share name */
+           while (*start && *start != '/' && *start != '\\')
+               *tmpstart++ = *start++;
+       }
+    }
+    sep = *start++;
+    if (sep == '/' || sep == '\\')
+       *tmpstart++ = '/';
+    *tmpstart = '\0';
+    while (sep) {
+       /* walk up to slash */
+       while (*start && *start != '/' && *start != '\\')
+           ++start;
+
+       /* discard doubled slashes */
+       while (*start && (start[1] == '/' || start[1] == '\\'))
+           ++start;
+       sep = *start;
+
+       /* stop and find full name of component */
+       *start = '\0';
+       fhand = FindFirstFile(path,&fdata);
+       if (fhand != INVALID_HANDLE_VALUE) {
+           strcpy(tmpstart, fdata.cFileName);
+           tmpstart += strlen(fdata.cFileName);
+           if (sep)
+               *tmpstart++ = '/';
+           *tmpstart = '\0';
+           *start++ = sep;
+           FindClose(fhand);
+       }
+       else {
+           /* failed a step, just return without side effects */
+           /*PerlIO_printf(PerlIO_stderr(), "Failed to find %s\n", path);*/
+           *start = sep;
+           return Nullch;
+       }
+    }
+    strcpy(path,tmpbuf);
+    return path;
+}
+
 #ifndef USE_WIN32_RTL_ENV
 
 DllExport char *
@@ -2843,6 +2929,29 @@ XS(w32_GetFullPathName)
 }
 
 static
+XS(w32_GetLongPathName)
+{
+    dXSARGS;
+    SV *path;
+    char tmpbuf[MAX_PATH+1];
+    char *pathstr;
+    STRLEN len;
+
+    if (items != 1)
+       croak("usage: Win32::GetLongPathName($pathname)");
+
+    path = ST(0);
+    pathstr = SvPV(path,len);
+    strcpy(tmpbuf, pathstr);
+    pathstr = win32_longpath(tmpbuf);
+    if (pathstr) {
+       ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
+       XSRETURN(1);
+    }
+    XSRETURN_EMPTY;
+}
+
+static
 XS(w32_Sleep)
 {
     dXSARGS;
@@ -2882,6 +2991,7 @@ Perl_init_os_extras()
     newXS("Win32::GetTickCount", w32_GetTickCount, file);
     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
     newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
+    newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
     newXS("Win32::Sleep", w32_Sleep, file);
 
     /* XXX Bloat Alert! The following Activeware preloads really

diff --git a/win32/win32iop.h b/win32/win32iop.h
index a0649b1..bcdc304 100644 (file)
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -122,6 +122,7 @@ DllExport  unsigned         win32_sleep(unsigned int);
 DllExport  int         win32_times(struct tms *timebuf);
 DllExport  unsigned    win32_alarm(unsigned int sec);
 DllExport  int         win32_stat(const char *path, struct stat *buf);
+DllExport  char*       win32_longpath(char *path);
 DllExport  int         win32_ioctl(int i, unsigned int u, char *data);
 DllExport  int         win32_utime(const char *f, struct utimbuf *t);
 DllExport  int         win32_uname(struct utsname *n);
@@ -207,6 +208,7 @@ END_EXTERN_C
 #define abort()                        win32_abort()
 #define fstat(fd,bufptr)       win32_fstat(fd,bufptr)
 #define stat(pth,bufptr)       win32_stat(pth,bufptr)
+#define longpath(pth)          win32_longpath(pth)
 #define rename(old,new)                win32_rename(old,new)
 #define setmode(fd,mode)       win32_setmode(fd,mode)
 #define lseek(fd,offset,orig)  win32_lseek(fd,offset,orig)