char buffer[MAX_PATH+1];
int l = strlen(path);
int res;
- HANDLE handle;
int nlink = 1;
+ BOOL expect_dir = FALSE;
+
+ GV *gv_sloppy = gv_fetchpvs("\027IN32_SLOPPY_STAT",
+ GV_NOTQUAL, SVt_PV);
+ BOOL sloppy = gv_sloppy && SvTRUE(GvSV(gv_sloppy));
if (l > 1) {
switch(path[l - 1]) {
/* FindFirstFile() and stat() are buggy with a trailing
- * backslash, so change it to a forward slash :-( */
+ * slashes, except for the root directory of a drive */
case '\\':
- if (l >= sizeof(buffer)) {
+ case '/':
+ if (l > sizeof(buffer)) {
errno = ENAMETOOLONG;
return -1;
}
- strncpy(buffer, path, l-1);
- buffer[l - 1] = '/';
- buffer[l] = '\0';
- path = buffer;
+ --l;
+ strncpy(buffer, path, l);
+ /* remove additional trailing slashes */
+ while (l > 1 && (buffer[l-1] == '/' || buffer[l-1] == '\\'))
+ --l;
+ /* add back slash if we otherwise end up with just a drive letter */
+ if (l == 2 && isALPHA(buffer[0]) && buffer[1] == ':')
+ buffer[l++] = '\\';
+ buffer[l] = '\0';
+ path = buffer;
+ expect_dir = TRUE;
break;
+
/* FindFirstFile() is buggy with "x:", so add a dot :-( */
case ':':
if (l == 2 && isALPHA(path[0])) {
}
}
- /* We *must* open & close the file once; otherwise file attribute changes */
- /* might not yet have propagated to "other" hard links of the same file. */
- /* This also gives us an opportunity to determine the number of links. */
path = PerlDir_mapA(path);
l = strlen(path);
- handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
- if (handle != INVALID_HANDLE_VALUE) {
- BY_HANDLE_FILE_INFORMATION bhi;
- if (GetFileInformationByHandle(handle, &bhi))
- nlink = bhi.nNumberOfLinks;
- CloseHandle(handle);
+
+ if (!sloppy) {
+ /* We must open & close the file once; otherwise file attribute changes */
+ /* might not yet have propagated to "other" hard links of the same file. */
+ /* This also gives us an opportunity to determine the number of links. */
+ HANDLE handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL);
+ if (handle != INVALID_HANDLE_VALUE) {
+ BY_HANDLE_FILE_INFORMATION bhi;
+ if (GetFileInformationByHandle(handle, &bhi))
+ nlink = bhi.nNumberOfLinks;
+ CloseHandle(handle);
+ }
}
/* path will be mapped correctly above */
return -1;
}
}
+ if (expect_dir && !S_ISDIR(sbuf->st_mode)) {
+ errno = ENOTDIR;
+ return -1;
+ }
#ifdef __BORLANDC__
if (S_ISDIR(sbuf->st_mode))
sbuf->st_mode |= S_IWRITE | S_IEXEC;
w32_poll_count = 0;
- if (hwnd == INVALID_HANDLE_VALUE)
+ if (hwnd == INVALID_HANDLE_VALUE) {
+ /* Call PeekMessage() to mark all pending messages in the queue as "old".
+ * This is necessary when we are being called by win32_msgwait() to
+ * make sure MsgWaitForMultipleObjects() stops reporting the same waiting
+ * message over and over. An example how this can happen is when
+ * Perl is calling win32_waitpid() inside a GUI application and the GUI
+ * is generating messages before the process terminated.
+ */
+ PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE|PM_NOYIELD);
+ if (PL_sig_pending)
+ despatch_signals();
return 1;
+ }
/* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages
* and ignores window messages - should co-exist better with windows apps e.g. Tk
if (win32_pipe(p, 512, ourmode) == -1)
return NULL;
- /* save current stdfd */
- if ((oldfd = win32_dup(stdfd)) == -1)
- goto cleanup;
-
/* save the old std handle (this needs to happen before the
* dup2(), since that might call SetStdHandle() too) */
OP_REFCNT_LOCK;
lock_held = 1;
old_h = GetStdHandle(nhandle);
+ /* save current stdfd */
+ if ((oldfd = win32_dup(stdfd)) == -1)
+ goto cleanup;
+
/* make stdfd go to child end of pipe (implicitly closes stdfd) */
/* stdfd will be inherited by the child */
if (win32_dup2(p[child], stdfd) == -1)
if (win32_dup2(oldfd, stdfd) == -1)
goto cleanup;
+ /* close saved handle */
+ win32_close(oldfd);
+
/* restore the old std handle (this needs to happen after the
* dup2(), since that might call SetStdHandle() too */
if (lock_held) {
lock_held = 0;
}
- /* close saved handle */
- win32_close(oldfd);
-
LOCK_FDPID_MUTEX;
sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
UNLOCK_FDPID_MUTEX;
/* we don't need to check for errors here */
win32_close(p[0]);
win32_close(p[1]);
+ if (oldfd != -1) {
+ win32_dup2(oldfd, stdfd);
+ win32_close(oldfd);
+ }
if (lock_held) {
SetStdHandle(nhandle, old_h);
OP_REFCNT_UNLOCK;
lock_held = 0;
}
- if (oldfd != -1) {
- win32_dup2(oldfd, stdfd);
- win32_close(oldfd);
- }
return (NULL);
#endif /* USE_RTL_POPEN */
childpid = 0;
if (!childpid) {
+ UNLOCK_FDPID_MUTEX;
errno = EBADF;
return -1;
}
void
Perl_win32_term(void)
{
+ HINTS_REFCNT_TERM;
OP_REFCNT_TERM;
MALLOC_TERM;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff