diff options
Diffstat (limited to 'win32')
| -rw-r--r-- | win32/Makefile | 18 | ||||
| -rw-r--r-- | win32/config.vc | 2 | ||||
| -rw-r--r-- | win32/config_H.vc | 2 | ||||
| -rw-r--r-- | win32/makedef.pl | 1 | ||||
| -rw-r--r-- | win32/makefile.mk | 17 | ||||
| -rw-r--r-- | win32/runperl.c | 5 | ||||
| -rw-r--r-- | win32/win32.c | 159 | ||||
| -rw-r--r-- | win32/win32iop.h | 2 |
8 files changed, 183 insertions, 23 deletions
diff --git a/win32/Makefile b/win32/Makefile index 49271f27cd..ffa8c6b1a4 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -509,7 +509,7 @@ SETARGV_OBJ = setargv$(o) !ENDIF DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ - Data/Dumper Devel/Peek + Data/Dumper Devel/Peek ByteLoader STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -527,6 +527,7 @@ RE = $(EXTDIR)\re\re DUMPER = $(EXTDIR)\Data\Dumper\Dumper ERRNO = $(EXTDIR)\Errno\Errno PEEK = $(EXTDIR)\Devel\Peek\Peek +BYTELOADER = $(EXTDIR)\ByteLoader SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -540,6 +541,7 @@ B_DLL = $(AUTODIR)\B\B.dll DUMPER_DLL = $(AUTODIR)\Data\Dumper\Dumper.dll PEEK_DLL = $(AUTODIR)\Devel\Peek\Peek.dll RE_DLL = $(AUTODIR)\re\re.dll +BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll ERRNO_PM = $(LIBDIR)\Errno.pm @@ -555,7 +557,8 @@ EXTENSION_C = \ $(RE).c \ $(DUMPER).c \ $(PEEK).c \ - $(B).c + $(B).c \ + $(BYTELOADER).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -567,7 +570,8 @@ EXTENSION_DLL = \ $(ATTRS_DLL) \ $(DUMPER_DLL) \ $(PEEK_DLL) \ - $(B_DLL) + $(B_DLL) \ + $(BYTELOADER_DLL) EXTENSION_PM = \ $(ERRNO_PM) @@ -857,6 +861,12 @@ $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs $(MAKE) cd ..\..\win32 +$(BYTELOADER_DLL): $(PERLEXE) $(BYTELOADER).xs + cd $(EXTDIR)\$(*B) + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\win32 + $(ERRNO_PM): $(PERLEXE) $(ERRNO)_pm.PL cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl @@ -889,7 +899,7 @@ distclean: clean -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm - -del /f $(LIBDIR)\Data\Dumper.pm + -del /f $(LIBDIR)\Data\Dumper.pm $(LIBDIR)\ByteLoader.pm -del /f $(LIBDIR)\Devel\Peek.pm -rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO -rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread diff --git a/win32/config.vc b/win32/config.vc index cf4799baa4..ea86e5f530 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -82,7 +82,7 @@ d_bsd='define' d_bsdgetpgrp='undef' d_bsdsetpgrp='undef' d_bzero='undef' -d_casti32='define' +d_casti32='undef' d_castneg='define' d_charvspr='undef' d_chown='undef' diff --git a/win32/config_H.vc b/win32/config_H.vc index aab6935aca..432e95d95d 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -1091,7 +1091,7 @@ * This symbol is defined if the C compiler can cast negative * or large floating point numbers to 32-bit ints. */ -#define CASTI32 /**/ +/*#define CASTI32 /**/ /* CASTNEGFLOAT: * This symbol is defined if the C compiler can cast negative diff --git a/win32/makedef.pl b/win32/makedef.pl index 0a753fbfe1..f13c1da0a7 100644 --- 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/makefile.mk b/win32/makefile.mk index 32056a9d33..bee351ce03 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -624,7 +624,7 @@ SETARGV_OBJ = setargv$(o) .ENDIF DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ - Data/Dumper Devel/Peek + Data/Dumper Devel/Peek ByteLoader STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -642,6 +642,7 @@ RE = $(EXTDIR)\re\re DUMPER = $(EXTDIR)\Data\Dumper\Dumper ERRNO = $(EXTDIR)\Errno\Errno PEEK = $(EXTDIR)\Devel\Peek\Peek +BYTELOADER = $(EXTDIR)\ByteLoader SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -655,6 +656,7 @@ B_DLL = $(AUTODIR)\B\B.dll DUMPER_DLL = $(AUTODIR)\Data\Dumper\Dumper.dll PEEK_DLL = $(AUTODIR)\Devel\Peek\Peek.dll RE_DLL = $(AUTODIR)\re\re.dll +BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll ERRNO_PM = $(LIBDIR)\Errno.pm @@ -670,7 +672,8 @@ EXTENSION_C = \ $(RE).c \ $(DUMPER).c \ $(PEEK).c \ - $(B).c + $(B).c \ + $(BYTELOADER).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -682,7 +685,8 @@ EXTENSION_DLL = \ $(ATTRS_DLL) \ $(DUMPER_DLL) \ $(PEEK_DLL) \ - $(B_DLL) + $(B_DLL) \ + $(BYTELOADER_DLL) EXTENSION_PM = \ $(ERRNO_PM) @@ -1024,6 +1028,11 @@ $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl cd $(EXTDIR)\$(*B) && $(MAKE) +$(BYTELOADER_DLL): $(PERLEXE) $(BYTELOADER).xs + cd $(EXTDIR)\$(*B) && \ + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\$(*B) && $(MAKE) + $(ERRNO_PM): $(PERLEXE) $(ERRNO)_pm.PL cd $(EXTDIR)\$(*B) && \ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl @@ -1052,7 +1061,7 @@ distclean: clean -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm - -del /f $(LIBDIR)\Data\Dumper.pm + -del /f $(LIBDIR)\Data\Dumper.pm $(LIBDIR)\ByteLoader.pm -del /f $(LIBDIR)\Devel\Peek.pm -rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO -rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread diff --git a/win32/runperl.c b/win32/runperl.c index 8cf521d4ea..1b569d2557 100644 --- a/win32/runperl.c +++ b/win32/runperl.c @@ -41,8 +41,10 @@ main(int argc, char **argv, char **env) * want to free() argv after main() returns. As luck would have it, * Borland's CRT does the right thing to argv[0] already. */ char szModuleName[MAX_PATH]; + char *ptr; GetModuleFileName(NULL, szModuleName, sizeof(szModuleName)); + (void)win32_longpath(szModuleName); argv[0] = szModuleName; #endif @@ -87,7 +89,10 @@ main(int argc, char **argv, char **env) * want to free() argv after main() returns. As luck would have it, * Borland's CRT does the right thing to argv[0] already. */ char szModuleName[MAX_PATH]; + char *ptr; + GetModuleFileName(NULL, szModuleName, sizeof(szModuleName)); + (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 1848e9ba27..414e4c5dfc 100644 --- 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,39 @@ 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)); - ptr = strrchr(mod_name, '\\'); + 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 */ optr = ptr; *ptr = '\0'; - ptr = strrchr(mod_name, '\\'); + ptr = strrchr(mod_name, '/'); if (!ptr || stricmp(ptr+1, strip) != 0) { - if(!(*strip == '5' && *(ptr+1) == '5' && strncmp(strip, base, 5) == 0 - && strncmp(ptr+1, base, 5) == 0)) { - *optr = '\\'; + if(!(*strip == '5' && *(ptr+1) == '5' + && strncmp(strip, base, 5) == 0 + && strncmp(ptr+1, base, 5) == 0)) + { + *optr = '/'; ptr = optr; } } @@ -213,7 +234,7 @@ get_emd_part(char *prev_path, char *trailing_path, ...) if (!ptr) { ptr = mod_name; *ptr++ = '.'; - *ptr = '\\'; + *ptr = '/'; } va_end(ap); strcpy(++ptr, trailing_path); @@ -273,7 +294,7 @@ win32_get_sitelib(char *pl) /* $sitelib .= * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */ - sprintf(pathstr, "site\\%s\\lib", pl); + sprintf(pathstr, "site/%s/lib", pl); path1 = get_emd_part(path1, pathstr, ARCHNAME, "bin", pl, Nullch); /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */ @@ -281,7 +302,7 @@ win32_get_sitelib(char *pl) /* $sitelib .= * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib"; */ - path2 = get_emd_part(path2, "site\\lib", ARCHNAME, "bin", pl, Nullch); + path2 = get_emd_part(path2, "site/lib", ARCHNAME, "bin", pl, Nullch); if (!path1) return path2; @@ -365,8 +386,7 @@ my_popen(char *cmd, char *mode) #define fixcmd(x) #endif fixcmd(cmd); - win32_fflush(stdout); - win32_fflush(stderr); + PERL_FLUSHALL_FOR_CHILD; return win32_popen(cmd, mode); } @@ -968,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 * @@ -2832,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; @@ -2841,6 +2961,17 @@ XS(w32_Sleep) XSRETURN_YES; } +static +XS(w32_CopyFile) +{ + dXSARGS; + if (items != 3) + croak("usage: Win32::CopyFile($from, $to, $overwrite)"); + if (CopyFile(SvPV_nolen(ST(0)), SvPV_nolen(ST(1)), !SvTRUE(ST(2)))) + XSRETURN_YES; + XSRETURN_NO; +} + void Perl_init_os_extras() { @@ -2871,6 +3002,8 @@ 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::CopyFile", w32_CopyFile, 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 a0649b1623..bcdc304511 100644 --- 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) |