Update Archive-Extract to CPAN version 0.46

[perl5.git] / win32 / win32.c

diff --git a/win32/win32.c b/win32/win32.c
index 050c50c..3d1f460 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -22,6 +22,7 @@
 #  define WC_NO_BEST_FIT_CHARS 0x00000400 /* requires Windows 2000 or later */
 #endif
 #include <winnt.h>
+#include <commctrl.h>
 #include <tlhelp32.h>
 #include <io.h>
 #include <signal.h>
@@ -848,7 +849,6 @@ win32_opendir(const char *filename)
     long               len;
     long               idx;
     char               scanname[MAX_PATH+3];
-    Stat_t             sbuf;
     WIN32_FIND_DATAA   aFindData;
     WIN32_FIND_DATAW   wFindData;
     bool                using_wide;
@@ -856,12 +856,24 @@ win32_opendir(const char *filename)
     char               *ptr;
 
     len = strlen(filename);
-    if (len > MAX_PATH)
+    if (len == 0) {
+       errno = ENOENT;
        return NULL;
-
-    /* check to see if filename is a directory */
-    if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode))
+    }
+    if (len > MAX_PATH) {
+       errno = ENAMETOOLONG;
        return NULL;
+    }
+
+#if 0 /* This call to stat is unnecessary. The FindFirstFile() below will
+       * fail with ERROR_PATH_NOT_FOUND if filename is not a directory. */
+    {
+       /* check to see if filename is a directory */
+       Stat_t sbuf;
+       if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode))
+           return NULL;
+    }
+#endif
 
     /* Get us a DIR structure */
     Newxz(dirp, 1, DIR);
@@ -969,10 +981,13 @@ win32_readdir(DIR *dirp)
            char buffer[MAX_PATH*2];
             char *ptr;
 
+            if (dirp->handle == INVALID_HANDLE_VALUE) {
+                res = 0;
+            }
            /* finding the next file that matches the wildcard
             * (which should be all of them in this directory!).
             */
-           if (IsWin2000()) {
+           else if (IsWin2000()) {
                 WIN32_FIND_DATAW wFindData;
                res = FindNextFileW(dirp->handle, &wFindData);
                if (res) {
@@ -1007,8 +1022,13 @@ win32_readdir(DIR *dirp)
                dirp->end = dirp->start + newsize;
                dirp->nfiles++;
            }
-           else
+           else {
                dirp->curr = NULL;
+                if (dirp->handle != INVALID_HANDLE_VALUE) {
+                    FindClose(dirp->handle);
+                    dirp->handle = INVALID_HANDLE_VALUE;
+                }
+            }
        }
        return &(dirp->dirstr);
     }
@@ -1020,7 +1040,7 @@ win32_readdir(DIR *dirp)
 DllExport long
 win32_telldir(DIR *dirp)
 {
-    return (dirp->curr - dirp->start);
+    return dirp->curr ? (dirp->curr - dirp->start) : -1;
 }
 
 
@@ -1030,7 +1050,7 @@ win32_telldir(DIR *dirp)
 DllExport void
 win32_seekdir(DIR *dirp, long loc)
 {
-    dirp->curr = dirp->start + loc;
+    dirp->curr = loc == -1 ? NULL : dirp->start + loc;
 }
 
 /* Rewinddir resets the string pointer to the start */
@@ -1052,6 +1072,50 @@ win32_closedir(DIR *dirp)
     return 1;
 }
 
+/* duplicate a open DIR* for interpreter cloning */
+DllExport DIR *
+win32_dirp_dup(DIR *const dirp, CLONE_PARAMS *const param)
+{
+    dVAR;
+    PerlInterpreter *const from = param->proto_perl;
+    PerlInterpreter *const to   = PERL_GET_THX;
+
+    long pos;
+    DIR *dup;
+
+    /* switch back to original interpreter because win32_readdir()
+     * might Renew(dirp->start).
+     */
+    if (from != to) {
+        PERL_SET_THX(from);
+    }
+
+    /* mark current position; read all remaining entries into the
+     * cache, and then restore to current position.
+     */
+    pos = win32_telldir(dirp);
+    while (win32_readdir(dirp)) {
+        /* read all entries into cache */
+    }
+    win32_seekdir(dirp, pos);
+
+    /* switch back to new interpreter to allocate new DIR structure */
+    if (from != to) {
+        PERL_SET_THX(to);
+    }
+
+    Newx(dup, 1, DIR);
+    memcpy(dup, dirp, sizeof(DIR));
+
+    Newx(dup->start, dirp->size, char);
+    memcpy(dup->start, dirp->start, dirp->size);
+
+    dup->end = dup->start + (dirp->end - dirp->start);
+    if (dirp->curr)
+        dup->curr = dup->start + (dirp->curr - dirp->start);
+
+    return dup;
+}
 
 /*
  * various stubs
@@ -3508,6 +3572,27 @@ win32_eof(int fd)
 }
 
 DllExport int
+win32_isatty(int fd)
+{
+    /* The Microsoft isatty() function returns true for *all*
+     * character mode devices, including "nul".  Our implementation
+     * should only return true if the handle has a console buffer.
+     */
+    DWORD mode;
+    HANDLE fh = (HANDLE)_get_osfhandle(fd);
+    if (fh == (HANDLE)-1) {
+        /* errno is already set to EBADF */
+        return 0;
+    }
+
+    if (GetConsoleMode(fh, &mode))
+        return 1;
+
+    errno = ENOTTY;
+    return 0;
+}
+
+DllExport int
 win32_dup(int fd)
 {
     return dup(fd);
@@ -4817,6 +4902,16 @@ Perl_win32_init(int *argcp, char ***argvp)
 #endif
     MALLOC_INIT;
 
+    /* When the manifest resource requests Common-Controls v6 then
+     * user32.dll no longer registers all the Windows classes used for
+     * standard controls but leaves some of them to be registered by
+     * comctl32.dll.  InitCommonControls() doesn't do anything but calling
+     * it makes sure comctl32.dll gets loaded into the process and registers
+     * the standard control classes.  Without this even normal Windows APIs
+     * like MessageBox() can fail under some versions of Windows XP.
+     */
+    InitCommonControls();
+
     module = GetModuleHandle("ntdll.dll");
     if (module) {
         *(FARPROC*)&pfnZwQuerySystemInformation = GetProcAddress(module, "ZwQuerySystemInformation");