This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
v5.13.7 epigram added.
[perl5.git] / win32 / wince.c
index 60a6809..b9163d7 100644 (file)
@@ -70,12 +70,13 @@ static int          do_spawn2(pTHX_ char *cmd, int exectype);
 static BOOL            has_shell_metachars(char *ptr);
 static long            filetime_to_clock(PFILETIME ft);
 static BOOL            filetime_from_time(PFILETIME ft, time_t t);
-static char *          get_emd_part(SV **leading, char *trailing, ...);
+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 char *          qualified_path(const char *cmd);
 static char *          win32_get_xlib(const char *pl, const char *xlib,
-                                      const char *libname);
+                                      const char *libname, STRLEN *const len);
 
 #ifdef USE_ITHREADS
 static void            remove_dead_pseudo_process(long child);
@@ -171,7 +172,7 @@ get_regstr(const char *valuename, SV **svp)
 
 /* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
 static char *
-get_emd_part(SV **prev_pathp, char *trailing_path, ...)
+get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
 {
     char base[10];
     va_list ap;
@@ -228,6 +229,8 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
            *prev_pathp = sv_2mortal(newSVpvn("",0));
        sv_catpvn(*prev_pathp, ";", 1);
        sv_catpv(*prev_pathp, mod_name);
+       if(len)
+           *len = SvCUR(*prev_pathp);
        return SvPVX(*prev_pathp);
     }
 
@@ -235,7 +238,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
 }
 
 char *
-win32_get_privlib(const char *pl)
+win32_get_privlib(const char *pl, STRLEN *const len)
 {
     dTHX;
     char *stdlib = "lib";
@@ -248,11 +251,12 @@ win32_get_privlib(const char *pl)
        (void)get_regstr(stdlib, &sv);
 
     /* $stdlib .= ";$EMD/../../lib" */
-    return get_emd_part(&sv, stdlib, ARCHNAME, "bin", NULL);
+    return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL);
 }
 
 static char *
-win32_get_xlib(const char *pl, const char *xlib, const char *libname)
+win32_get_xlib(const char *pl, const char *xlib, const char *libname,
+              STRLEN *const len)
 {
     dTHX;
     char regstr[40];
@@ -269,7 +273,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, NULL);
+    (void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
 
     /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
     (void)get_regstr(xlib, &sv2);
@@ -277,25 +281,26 @@ 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, NULL);
+    (void)get_emd_part(&sv2, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
 
     if (!sv1 && !sv2)
        return NULL;
-    if (!sv1)
-       return SvPVX(sv2);
-    if (!sv2)
-       return SvPVX(sv1);
-
-    sv_catpvn(sv1, ";", 1);
-    sv_catsv(sv1, sv2);
+    if (!sv1) {
+       sv1 = sv2;
+    } else if (sv2) {
+       sv_catpvn(sv1, ";", 1);
+       sv_catsv(sv1, sv2);
+    }
 
+    if (len)
+       *len = SvCUR(sv1);
     return SvPVX(sv1);
 }
 
 char *
-win32_get_sitelib(const char *pl)
+win32_get_sitelib(const char *pl, STRLEN *const len)
 {
-    return win32_get_xlib(pl, "sitelib", "site");
+    return win32_get_xlib(pl, "sitelib", "site", len);
 }
 
 #ifndef PERL_VENDORLIB_NAME
@@ -303,9 +308,9 @@ win32_get_sitelib(const char *pl)
 #endif
 
 char *
-win32_get_vendorlib(const char *pl)
+win32_get_vendorlib(const char *pl, STRLEN *const len)
 {
-    return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME);
+    return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME, len);
 }
 
 static BOOL
@@ -496,6 +501,8 @@ get_shell(void)
 int
 Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp)
 {
+  PERL_ARGS_ASSERT_DO_ASPAWN;
+
   Perl_croak(aTHX_ PL_no_func, "aspawn");
   return -1;
 }
@@ -619,18 +626,24 @@ do_spawn2(pTHX_ char *cmd, int exectype)
 int
 Perl_do_spawn(pTHX_ char *cmd)
 {
+    PERL_ARGS_ASSERT_DO_SPAWN;
+
     return do_spawn2(aTHX_ cmd, EXECF_SPAWN);
 }
 
 int
 Perl_do_spawn_nowait(pTHX_ char *cmd)
 {
+    PERL_ARGS_ASSERT_DO_SPAWN_NOWAIT;
+
     return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT);
 }
 
 bool
 Perl_do_exec(pTHX_ const char *cmd)
 {
+    PERL_ARGS_ASSERT_DO_EXEC;
+
     do_spawn2(aTHX_ cmd, EXECF_EXEC);
     return FALSE;
 }
@@ -880,8 +893,6 @@ win32_longpath(char *path)
   return path;
 }
 
-#ifndef USE_WIN32_RTL_ENV
-
 DllExport char *
 win32_getenv(const char *name)
 {
@@ -894,8 +905,6 @@ win32_putenv(const char *name)
   return xceputenv(name);
 }
 
-#endif
-
 static long
 filetime_to_clock(PFILETIME ft)
 {
@@ -2440,12 +2449,12 @@ XS(w32_GetOSVersion)
     if (!XCEGetVersionExA(&osver)) {
       XSRETURN_EMPTY;
     }
-    XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
-    XPUSHs(newSViv(osver.dwMajorVersion));
-    XPUSHs(newSViv(osver.dwMinorVersion));
-    XPUSHs(newSViv(osver.dwBuildNumber));
+    mXPUSHp(osver.szCSDVersion, strlen(osver.szCSDVersion));
+    mXPUSHi(osver.dwMajorVersion);
+    mXPUSHi(osver.dwMinorVersion);
+    mXPUSHi(osver.dwBuildNumber);
     /* WINCE = 3 */
-    XPUSHs(newSViv(osver.dwPlatformId));
+    mXPUSHi(osver.dwPlatformId);
     PUTBACK;
 }
 
@@ -2554,15 +2563,15 @@ XS(w32_GetPowerStatus)
       XSRETURN_EMPTY;
     }
 
-  XPUSHs(newSViv(sps.ACLineStatus));
-  XPUSHs(newSViv(sps.BatteryFlag));
-  XPUSHs(newSViv(sps.BatteryLifePercent));
-  XPUSHs(newSViv(sps.BatteryLifeTime));
-  XPUSHs(newSViv(sps.BatteryFullLifeTime));
-  XPUSHs(newSViv(sps.BackupBatteryFlag));
-  XPUSHs(newSViv(sps.BackupBatteryLifePercent));
-  XPUSHs(newSViv(sps.BackupBatteryLifeTime));
-  XPUSHs(newSViv(sps.BackupBatteryFullLifeTime));
+  mXPUSHi(sps.ACLineStatus);
+  mXPUSHi(sps.BatteryFlag);
+  mXPUSHi(sps.BatteryLifePercent);
+  mXPUSHi(sps.BatteryLifeTime);
+  mXPUSHi(sps.BatteryFullLifeTime);
+  mXPUSHi(sps.BackupBatteryFlag);
+  mXPUSHi(sps.BackupBatteryLifePercent);
+  mXPUSHi(sps.BackupBatteryLifeTime);
+  mXPUSHi(sps.BackupBatteryFullLifeTime);
 
   PUTBACK;
 }