Teach checkcfgvar.pl that : is also a comment character in shell scripts
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
index 21be48c..d459c94 100644 (file)
@@ -60,13 +60,6 @@ typedef struct {
 #include "EXTERN.h"
 #include "perl.h"
 
-/* GCC-2.95.2/Mingw32-1.1 forgot the WINAPI on CommandLineToArgvW() */
-#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)
-#  include <shellapi.h>
-#else
-EXTERN_C LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs);
-#endif
-
 #define NO_XSLOCKS
 #define PERL_NO_GET_CONTEXT
 #include "XSUB.h"
@@ -275,7 +268,7 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
     HKEY handle;
     DWORD type;
     const char *subkey = "Software\\Perl";
-    char *str = Nullch;
+    char *str = NULL;
     long retval;
 
     retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
@@ -373,7 +366,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
        return SvPVX(*prev_pathp);
     }
 
-    return Nullch;
+    return NULL;
 }
 
 char *
@@ -382,7 +375,7 @@ win32_get_privlib(const char *pl)
     dTHX;
     char *stdlib = "lib";
     char buffer[MAX_PATH+1];
-    SV *sv = Nullsv;
+    SV *sv = NULL;
 
     /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || "";  */
     sprintf(buffer, "%s-%s", stdlib, pl);
@@ -390,7 +383,7 @@ win32_get_privlib(const char *pl)
        (void)get_regstr(stdlib, &sv);
 
     /* $stdlib .= ";$EMD/../../lib" */
-    return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch);
+    return get_emd_part(&sv, stdlib, ARCHNAME, "bin", NULL);
 }
 
 static char *
@@ -399,8 +392,8 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname)
     dTHX;
     char regstr[40];
     char pathstr[MAX_PATH+1];
-    SV *sv1 = Nullsv;
-    SV *sv2 = Nullsv;
+    SV *sv1 = NULL;
+    SV *sv2 = NULL;
 
     /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */
     sprintf(regstr, "%s-%s", xlib, pl);
@@ -409,7 +402,7 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname)
     /* $xlib .=
      * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib";  */
     sprintf(pathstr, "%s/%s/lib", libname, pl);
-    (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch);
+    (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, NULL);
 
     /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
     (void)get_regstr(xlib, &sv2);
@@ -417,10 +410,10 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname)
     /* $xlib .=
      * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib";  */
     sprintf(pathstr, "%s/lib", libname);
-    (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, Nullch);
+    (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, NULL);
 
     if (!sv1 && !sv2)
-       return Nullch;
+       return NULL;
     if (!sv1)
        return SvPVX(sv2);
     if (!sv2)
@@ -556,7 +549,7 @@ win32_getpid(void)
 static long
 tokenize(const char *str, char **dest, char ***destv)
 {
-    char *retstart = Nullch;
+    char *retstart = NULL;
     char **retvstart = 0;
     int items = -1;
     if (str) {
@@ -591,7 +584,7 @@ tokenize(const char *str, char **dest, char ***destv)
                ++items;
            ret++;
        }
-       retvstart[items] = Nullch;
+       retvstart[items] = NULL;
        *ret++ = '\0';
        *ret = '\0';
     }
@@ -735,7 +728,7 @@ do_spawn2(pTHX_ const char *cmd, int exectype)
            if (*s)
                *s++ = '\0';
        }
-       *a = Nullch;
+       *a = NULL;
        if (argv[0]) {
            switch (exectype) {
            case EXECF_SPAWN:
@@ -764,7 +757,7 @@ do_spawn2(pTHX_ const char *cmd, int exectype)
        while (++i < w32_perlshell_items)
            argv[i] = w32_perlshell_vec[i];
        argv[i++] = (char *)cmd;
-       argv[i] = Nullch;
+       argv[i] = NULL;
        switch (exectype) {
        case EXECF_SPAWN:
            status = win32_spawnvp(P_WAIT, argv[0],
@@ -1557,7 +1550,7 @@ win32_longpath(char *path)
     char *start = path;
     char sep;
     if (!path)
-       return Nullch;
+       return NULL;
 
     /* drive prefix */
     if (isALPHA(path[0]) && path[1] == ':') {
@@ -1621,14 +1614,14 @@ win32_longpath(char *path)
            else {
                FindClose(fhand);
                errno = ERANGE;
-               return Nullch;
+               return NULL;
            }
        }
        else {
            /* failed a step, just return without side effects */
            /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
            errno = EINVAL;
-           return Nullch;
+           return NULL;
        }
     }
     strcpy(path,tmpbuf);
@@ -1705,7 +1698,7 @@ win32_getenv(const char *name)
 {
     dTHX;
     DWORD needlen;
-    SV *curitem = Nullsv;
+    SV *curitem = NULL;
 
     needlen = GetEnvironmentVariableA(name,NULL,0);
     if (needlen != 0) {
@@ -1726,7 +1719,7 @@ win32_getenv(const char *name)
     if (curitem && SvCUR(curitem))
        return SvPVX(curitem);
 
-    return Nullch;
+    return NULL;
 }
 
 DllExport int
@@ -2397,7 +2390,7 @@ win32_crypt(const char *txt, const char *salt)
     return des_fcrypt(txt, salt, w32_crypt_buffer);
 #else
     Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia.");
-    return Nullch;
+    return NULL;
 #endif
 }
 
@@ -3276,7 +3269,7 @@ win32_rename(const char *oname, const char *newname)
        int retval = 0;
        char szTmpName[MAX_PATH+1];
        char dname[MAX_PATH+1];
-       char *endname = Nullch;
+       char *endname = NULL;
        STRLEN tmplen = 0;
        DWORD from_attr, to_attr;
 
@@ -3335,7 +3328,7 @@ win32_rename(const char *oname, const char *newname)
        retval = rename(szOldName, szNewName);
 
        /* if we created a temporary file before ... */
-       if (endname != Nullch) {
+       if (endname != NULL) {
            /* ...and rename succeeded, delete temporary file/directory */
            if (retval == 0)
                DeleteFile(szTmpName);
@@ -3917,7 +3910,7 @@ qualified_path(const char *cmd)
     int has_slash = 0;
 
     if (!cmd)
-       return Nullch;
+       return NULL;
     fullcmd = (char*)cmd;
     while (*fullcmd) {
        if (*fullcmd == '/' || *fullcmd == '\\')
@@ -3991,7 +3984,7 @@ qualified_path(const char *cmd)
     }
 
     Safefree(fullcmd);
-    return Nullch;
+    return NULL;
 }
 
 /* The following are just place holders.
@@ -4078,7 +4071,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
     PROCESS_INFORMATION ProcessInformation;
     DWORD create = 0;
     char *cmd;
-    char *fullcmd = Nullch;
+    char *fullcmd = NULL;
     char *cname = (char *)cmdname;
     STRLEN clen = 0;
 
@@ -4589,15 +4582,17 @@ Perl_init_os_extras(void)
 {
     dTHX;
     char *file = __FILE__;
-    CV *cv;
-    dXSUB_SYS;
 
-    /* load Win32 CORE stubs, assuming Win32CORE was statically linked */
-    if ((cv = get_cv("Win32CORE::bootstrap", 0))) {
-       dSP;
-       PUSHMARK(SP);
-       (void)call_sv((SV *)cv, G_EVAL|G_DISCARD|G_VOID);
-    }
+    /* Initialize Win32CORE if it has been statically linked. */
+    void (*pfn_init)(pTHX);
+#if defined(__BORLANDC__)
+    /* makedef.pl seems to have given up on fixing this issue in the .def file */
+    pfn_init = (void (*)(pTHX))GetProcAddress((HMODULE)w32_perldll_handle, "_init_Win32CORE");
+#else
+    pfn_init = (void (*)(pTHX))GetProcAddress((HMODULE)w32_perldll_handle, "init_Win32CORE");
+#endif
+    if (pfn_init)
+        pfn_init(aTHX);
 
     newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
 }
@@ -4851,19 +4846,6 @@ win32_signal(int sig, Sighandler_t subcode)
     }
 }
 
-
-#ifdef HAVE_INTERP_INTERN
-
-static void
-win32_csighandler(int sig)
-{
-#if 0
-    dTHXa(PERL_GET_SIG_CONTEXT);
-    Perl_warn(aTHX_ "Got signal %d",sig);
-#endif
-    /* Does nothing */
-}
-
 HWND
 win32_create_message_window()
 {
@@ -4881,6 +4863,18 @@ win32_create_message_window()
     return CreateWindow("Static", "", 0, 0, 0, 0, 0, HWND_MESSAGE, 0, 0, NULL);
 }
 
+#ifdef HAVE_INTERP_INTERN
+
+static void
+win32_csighandler(int sig)
+{
+#if 0
+    dTHXa(PERL_GET_SIG_CONTEXT);
+    Perl_warn(aTHX_ "Got signal %d",sig);
+#endif
+    /* Does nothing */
+}
+
 #if defined(__MINGW32__) && defined(__cplusplus)
 #define CAST_HWND__(x) (HWND__*)(x)
 #else
@@ -4892,7 +4886,7 @@ Perl_sys_intern_init(pTHX)
 {
     int i;
 
-    w32_perlshell_tokens       = Nullch;
+    w32_perlshell_tokens       = NULL;
     w32_perlshell_vec          = (char**)NULL;
     w32_perlshell_items                = 0;
     w32_fdpid                  = newAV();
@@ -4962,7 +4956,7 @@ Perl_sys_intern_clear(pTHX)
 void
 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
 {
-    dst->perlshell_tokens      = Nullch;
+    dst->perlshell_tokens      = NULL;
     dst->perlshell_vec         = (char**)NULL;
     dst->perlshell_items       = 0;
     dst->fdpid                 = newAV();
@@ -4976,32 +4970,3 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
 }
 #  endif /* USE_ITHREADS */
 #endif /* HAVE_INTERP_INTERN */
-
-static void
-win32_free_argvw(pTHX_ void *ptr)
-{
-    char** argv = (char**)ptr;
-    while(*argv) {
-       Safefree(*argv);
-       *argv++ = Nullch;
-    }
-}
-
-void
-win32_argv2utf8(int argc, char** argv)
-{
-    dTHX;
-    char* psz;
-    int length, wargc;
-    LPWSTR* lpwStr = CommandLineToArgvW(GetCommandLineW(), &wargc);
-    if (lpwStr && argc) {
-       while (argc--) {
-           length = WideCharToMultiByte(CP_UTF8, 0, lpwStr[--wargc], -1, NULL, 0, NULL, NULL);
-           Newxz(psz, length, char);
-           WideCharToMultiByte(CP_UTF8, 0, lpwStr[wargc], -1, psz, length, NULL, NULL);
-           argv[argc] = psz;
-       }
-       call_atexit(win32_free_argvw, argv);
-    }
-    GlobalFree((HGLOBAL)lpwStr);
-}