This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deprecate /\C/
[perl5.git] / win32 / wince.c
index 8512b4d..271df2b 100644 (file)
@@ -13,7 +13,7 @@
 
 #define PERLIO_NOT_STDIO 0
 
-#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
+#if !defined(PERLIO_IS_STDIO)
 #define PerlIO FILE
 #endif
 
@@ -73,14 +73,14 @@ static BOOL         filetime_from_time(PFILETIME ft, time_t t);
 static char *          get_emd_part(SV **leading, STRLEN *const len,
                                     char *trailing, ...);
 static void            remove_dead_process(long deceased);
-static long            find_pid(int pid);
+static long            find_pid(pTHX_ int pid);
 static char *          qualified_path(const char *cmd);
 static char *          win32_get_xlib(const char *pl, const char *xlib,
                                       const char *libname, STRLEN *const len);
 
 #ifdef USE_ITHREADS
 static void            remove_dead_pseudo_process(long child);
-static long            find_pseudo_pid(int pid);
+static long            find_pseudo_pid(pTHX_ int pid);
 #endif
 
 int _fmode = O_TEXT; /* celib do not provide _fmode, so we define it here */
@@ -146,7 +146,7 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
        if (retval == ERROR_SUCCESS && type == REG_SZ) {
            dTHX;
            if (!*svp)
-               *svp = sv_2mortal(newSVpvn("",0));
+               *svp = sv_2mortal(newSVpvs(""));
            SvGROW(*svp, datalen);
            retval = XCERegQueryValueExA(handle, valuename, 0, NULL,
                                     (PBYTE)SvPVX(*svp), &datalen);
@@ -226,8 +226,8 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
        /* directory exists */
        dTHX;
        if (!*prev_pathp)
-           *prev_pathp = sv_2mortal(newSVpvn("",0));
-       sv_catpvn(*prev_pathp, ";", 1);
+           *prev_pathp = sv_2mortal(newSVpvs(""));
+       sv_catpvs(*prev_pathp, ";");
        sv_catpv(*prev_pathp, mod_name);
        if(len)
            *len = SvCUR(*prev_pathp);
@@ -261,8 +261,6 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname,
     dTHX;
     char regstr[40];
     char pathstr[MAX_PATH+1];
-    DWORD datalen;
-    int len, newsize;
     SV *sv1 = NULL;
     SV *sv2 = NULL;
 
@@ -288,7 +286,7 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname,
     if (!sv1) {
        sv1 = sv2;
     } else if (sv2) {
-       sv_catpvn(sv1, ";", 1);
+       sv_catpvs(sv1, ";");
        sv_catsv(sv1, sv2);
     }
 
@@ -417,8 +415,8 @@ tokenize(const char *str, char **dest, char ***destv)
     if (str) {
        dTHX;
        int slen = strlen(str);
-       register char *ret;
-       register char **retv;
+       char *ret;
+       char **retv;
        Newx(ret, slen+2, char);
        Newx(retv, (slen+3)/2, char*);
 
@@ -893,7 +891,51 @@ win32_longpath(char *path)
   return path;
 }
 
-#ifndef USE_WIN32_RTL_ENV
+static void
+out_of_memory(void)
+{
+    if (PL_curinterp) {
+        dTHX;
+        /* Can't use PerlIO to write as it allocates memory */
+        PerlLIO_write(PerlIO_fileno(Perl_error_log),
+                      PL_no_mem, strlen(PL_no_mem));
+        my_exit(1);
+    }
+    exit(1);
+}
+
+/* The win32_ansipath() function takes a Unicode filename and converts it
+ * into the current Windows codepage. If some characters cannot be mapped,
+ * then it will convert the short name instead.
+ *
+ * The buffer to the ansi pathname must be freed with win32_free() when it
+ * it no longer needed.
+ *
+ * The argument to win32_ansipath() must exist before this function is
+ * called; otherwise there is no way to determine the short path name.
+ *
+ * Ideas for future refinement:
+ * - Only convert those segments of the path that are not in the current
+ *   codepage, but leave the other segments in their long form.
+ * - If the resulting name is longer than MAX_PATH, start converting
+ *   additional path segments into short names until the full name
+ *   is shorter than MAX_PATH.  Shorten the filename part last!
+ */
+DllExport char *
+win32_ansipath(const WCHAR *widename)
+{
+    char *name;
+    size_t widelen = wcslen(widename)+1;
+    int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
+                                  NULL, 0, NULL, NULL);
+    name = win32_malloc(len);
+    if (!name)
+        out_of_memory();
+
+    WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
+                        name, len, NULL, NULL);
+    return name;
+}
 
 DllExport char *
 win32_getenv(const char *name)
@@ -907,8 +949,6 @@ win32_putenv(const char *name)
   return xceputenv(name);
 }
 
-#endif
-
 static long
 filetime_to_clock(PFILETIME ft)
 {
@@ -1502,9 +1542,6 @@ win32_tmpfd(void)
            if (fh != INVALID_HANDLE_VALUE) {
                int fd = win32_open_osfhandle((intptr_t)fh, 0);
                if (fd >= 0) {
-#if defined(__BORLANDC__)
-                   setmode(fd,O_BINARY);
-#endif
                    DEBUG_p(PerlIO_printf(Perl_debug_log,
                                          "Created tmpfile=%s\n",filename));
                    return fd;
@@ -2412,9 +2449,7 @@ XS(w32_GetCwd)
   EXTEND(SP,1);
   SvPOK_on(sv);
   ST(0) = sv;
-#ifndef INCOMPLETE_TAINTS
   SvTAINTED_on(ST(0));
-#endif
   XSRETURN(1);
 }
 
@@ -2741,12 +2776,6 @@ getcwd(char *buf, size_t size)
   return xcegetcwd(buf, size);
 }
 
-int
-isnan(double d)
-{
-  return _isnan(d);
-}
-
 
 DllExport PerlIO*
 win32_popenlist(const char *mode, IV narg, SV **args)