#include "EXTERN.h"
#include "perl.h"
+#include "patchlevel.h"
+
#define NO_XSLOCKS
#ifdef PERL_OBJECT
extern CPerlObj* pPerl;
static char *
get_emd_part(char *prev_path, char *trailing_path, ...)
{
+ char base[10];
va_list ap;
char mod_name[MAX_PATH+1];
char *ptr;
va_start(ap, trailing_path);
strip = va_arg(ap, char *);
- GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE)
- ? GetModuleHandle(NULL)
- : w32_perldll_handle, mod_name, sizeof(mod_name));
+ sprintf(base, "%5.3f", (double) 5 + ((double) PATCHLEVEL / (double) 1000));
+
+ GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
+ ? GetModuleHandle(NULL) : w32_perldll_handle),
+ mod_name, sizeof(mod_name));
ptr = strrchr(mod_name, '\\');
while (ptr && strip) {
/* look for directories to skip back */
*ptr = '\0';
ptr = strrchr(mod_name, '\\');
if (!ptr || stricmp(ptr+1, strip) != 0) {
- *optr = '\\';
- ptr = optr;
+ if(!(*strip == '5' && *(ptr+1) == '5' && strncmp(strip, base, 5) == 0
+ && strncmp(ptr+1, base, 5) == 0)) {
+ *optr = '\\';
+ ptr = optr;
+ }
}
strip = va_arg(ap, char *);
}
va_end(ap);
strcpy(++ptr, trailing_path);
- newsize = strlen(mod_name) + 1;
- if (prev_path) {
- oldsize = strlen(prev_path) + 1;
- newsize += oldsize; /* includes plus 1 for ';' */
- Renew(prev_path, newsize, char);
- prev_path[oldsize-1] = ';';
- strcpy(&prev_path[oldsize], mod_name);
- }
- else {
- New(1311, prev_path, newsize, char);
- strcpy(prev_path, mod_name);
+ /* only add directory if it exists */
+ if(GetFileAttributes(mod_name) != (DWORD) -1) {
+ /* directory exists */
+ newsize = strlen(mod_name) + 1;
+ if (prev_path) {
+ oldsize = strlen(prev_path) + 1;
+ newsize += oldsize; /* includes plus 1 for ';' */
+ Renew(prev_path, newsize, char);
+ prev_path[oldsize-1] = ';';
+ strcpy(&prev_path[oldsize], mod_name);
+ }
+ else {
+ New(1311, prev_path, newsize, char);
+ strcpy(prev_path, mod_name);
+ }
}
return prev_path;
int status;
int flag = P_WAIT;
int index = 0;
+ STRLEN n_a;
if (sp <= mark)
return -1;
}
while (++mark <= sp) {
- if (*mark && (str = SvPV(*mark, PL_na)))
+ if (*mark && (str = SvPV(*mark, n_a)))
argv[index++] = str;
else
argv[index++] = "";
argv[index++] = 0;
status = win32_spawnvp(flag,
- (const char*)(really ? SvPV(really,PL_na) : argv[0]),
+ (const char*)(really ? SvPV(really,n_a) : argv[0]),
(const char* const*)argv);
- if (status < 0 && errno == ENOEXEC) {
+ if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
/* possible shell-builtin, invoke with shell */
int sh_items;
sh_items = w32_perlshell_items;
argv[sh_items] = w32_perlshell_vec[sh_items];
status = win32_spawnvp(flag,
- (const char*)(really ? SvPV(really,PL_na) : argv[0]),
+ (const char*)(really ? SvPV(really,n_a) : argv[0]),
(const char* const*)argv);
}
/* do the FindFirstFile call */
fh = FindFirstFile(scanname, &FindData);
if (fh == INVALID_HANDLE_VALUE) {
+ /* FindFirstFile() fails on empty drives! */
+ if (GetLastError() == ERROR_FILE_NOT_FOUND)
+ return p;
+ Safefree( p);
return NULL;
}
return win32_wait(status);
else {
rc = cwait(status, pid, WAIT_CHILD);
- /* cwait() returns differently on Borland */
-#ifdef __BORLANDC__
+ /* cwait() returns "correctly" on Borland */
+#ifndef __BORLANDC__
if (status)
- *status = (((*status >> 8) & 0xff) | ((*status << 8) & 0xff00));
+ *status *= 256;
#endif
remove_dead_process((HANDLE)pid);
}
/* wait for the child */
if (cwait(&status, childpid, WAIT_CHILD) == -1)
return (-1);
- /* cwait() returns differently on Borland */
-#ifdef __BORLANDC__
- return (((status >> 8) & 0xff) | ((status << 8) & 0xff00));
-#else
- return (status);
+ /* cwait() returns "correctly" on Borland */
+#ifndef __BORLANDC__
+ status *= 256;
#endif
+ return (status);
#endif /* USE_RTL_POPEN */
}
DllExport int
win32_rename(const char *oname, const char *newname)
{
- char szNewWorkName[MAX_PATH+1];
- WIN32_FIND_DATA fdOldFile, fdNewFile;
- HANDLE handle;
- char *ptr;
-
- if ((strchr(oname, '\\') || strchr(oname, '/'))
- && strchr(newname, '\\') == NULL
- && strchr(newname, '/') == NULL)
- {
- strcpy(szNewWorkName, oname);
- if ((ptr = strrchr(szNewWorkName, '\\')) == NULL)
- ptr = strrchr(szNewWorkName, '/');
- strcpy(++ptr, newname);
+ /* XXX despite what the documentation says about MoveFileEx(),
+ * it doesn't work under Windows95!
+ */
+ if (IsWinNT()) {
+ if (!MoveFileEx(oname,newname,
+ MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING)) {
+ DWORD err = GetLastError();
+ switch (err) {
+ case ERROR_BAD_NET_NAME:
+ case ERROR_BAD_NETPATH:
+ case ERROR_BAD_PATHNAME:
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_FILENAME_EXCED_RANGE:
+ case ERROR_INVALID_DRIVE:
+ case ERROR_NO_MORE_FILES:
+ case ERROR_PATH_NOT_FOUND:
+ errno = ENOENT;
+ break;
+ default:
+ errno = EACCES;
+ break;
+ }
+ return -1;
+ }
+ return 0;
}
- else
- strcpy(szNewWorkName, newname);
-
- if (stricmp(oname, szNewWorkName) != 0) {
- // check that we're not being fooled by relative paths
- // and only delete the new file
- // 1) if it exists
- // 2) it is not the same file as the old file
- // 3) old file exist
- // GetFullPathName does not return the long file name on some systems
- handle = FindFirstFile(oname, &fdOldFile);
- if (handle != INVALID_HANDLE_VALUE) {
- FindClose(handle);
-
- handle = FindFirstFile(szNewWorkName, &fdNewFile);
-
- if (handle != INVALID_HANDLE_VALUE)
- FindClose(handle);
+ else {
+ int retval = 0;
+ char tmpname[MAX_PATH+1];
+ char dname[MAX_PATH+1];
+ char *endname = Nullch;
+ STRLEN tmplen = 0;
+ DWORD from_attr, to_attr;
+
+ /* if oname doesn't exist, do nothing */
+ from_attr = GetFileAttributes(oname);
+ if (from_attr == 0xFFFFFFFF) {
+ errno = ENOENT;
+ return -1;
+ }
+
+ /* if newname exists, rename it to a temporary name so that we
+ * don't delete it in case oname happens to be the same file
+ * (but perhaps accessed via a different path)
+ */
+ to_attr = GetFileAttributes(newname);
+ if (to_attr != 0xFFFFFFFF) {
+ /* if newname is a directory, we fail
+ * XXX could overcome this with yet more convoluted logic */
+ if (to_attr & FILE_ATTRIBUTE_DIRECTORY) {
+ errno = EACCES;
+ return -1;
+ }
+ tmplen = strlen(newname);
+ strcpy(tmpname,newname);
+ endname = tmpname+tmplen;
+ for (; endname > tmpname ; --endname) {
+ if (*endname == '/' || *endname == '\\') {
+ *endname = '\0';
+ break;
+ }
+ }
+ if (endname > tmpname)
+ endname = strcpy(dname,tmpname);
else
- fdNewFile.cFileName[0] = '\0';
-
- if (strcmp(fdOldFile.cAlternateFileName,
- fdNewFile.cAlternateFileName) != 0
- && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
- {
- // file exists and not same file
- DeleteFile(szNewWorkName);
+ endname = ".";
+
+ /* get a temporary filename in same directory
+ * XXX is this really the best we can do? */
+ if (!GetTempFileName((LPCTSTR)endname, "plr", 0, tmpname)) {
+ errno = ENOENT;
+ return -1;
+ }
+ DeleteFile(tmpname);
+
+ retval = rename(newname, tmpname);
+ if (retval != 0) {
+ errno = EACCES;
+ return retval;
}
}
+
+ /* rename oname to newname */
+ retval = rename(oname, newname);
+
+ /* if we created a temporary file before ... */
+ if (endname != Nullch) {
+ /* ...and rename succeeded, delete temporary file/directory */
+ if (retval == 0)
+ DeleteFile(tmpname);
+ /* else restore it to what it was */
+ else
+ (void)rename(tmpname, newname);
+ }
+ return retval;
}
- return rename(oname, newname);
}
DllExport int
XS(w32_SetCwd)
{
dXSARGS;
+ STRLEN n_a;
if (items != 1)
croak("usage: Win32::SetCurrentDirectory($cwd)");
- if (SetCurrentDirectory(SvPV(ST(0),PL_na)))
+ if (SetCurrentDirectory(SvPV(ST(0),n_a)))
XSRETURN_YES;
XSRETURN_NO;
PROCESS_INFORMATION stProcInfo;
STARTUPINFO stStartInfo;
BOOL bSuccess = FALSE;
+ STRLEN n_a;
if (items != 3)
croak("usage: Win32::Spawn($cmdName, $args, $PID)");
- cmd = SvPV(ST(0),PL_na);
- args = SvPV(ST(1), PL_na);
+ cmd = SvPV(ST(0),n_a);
+ args = SvPV(ST(1), n_a);
memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
projects / p5sagit/p5-mst-13.2.git / blobdiff