const int *handles);
static int do_spawnvp_handles(int mode, const char *cmdname,
const char * const *argv, const int *handles);
+static PerlIO * do_popen(const char *mode, const char *command, IV narg,
+ SV **args);
static long find_pid(pTHX_ int pid);
static void remove_dead_process(long child);
static int terminate_process(DWORD pid, HANDLE process_handle, int sig);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
static char* create_command_line(char *cname, STRLEN clen,
- const char * const *args);
+ const char * const *args);
static char* qualified_path(const char *cmd);
static void ansify_path(void);
static LRESULT win32_process_message(HWND hwnd, UINT msg,
{
dTHX;
if (!*svp)
- *svp = sv_2mortal(newSVpvn("",0));
+ *svp = sv_2mortal(newSVpvs(""));
SvGROW(*svp, datalen);
retval = RegQueryValueEx(handle, valuename, 0, NULL,
(PBYTE)SvPVX(*svp), &datalen);
/* directory exists */
dTHX;
if (!*prev_pathp)
- *prev_pathp = sv_2mortal(newSVpvn("",0));
+ *prev_pathp = sv_2mortal(newSVpvs(""));
else if (SvPVX(*prev_pathp))
- sv_catpvn(*prev_pathp, ";", 1);
+ sv_catpvs(*prev_pathp, ";");
sv_catpv(*prev_pathp, mod_name);
if(len)
*len = SvCUR(*prev_pathp);
sv1 = sv2;
} else if (sv2) {
dTHX;
- sv_catpvn(sv1, ";", 1);
+ sv_catpv(sv1, ";");
sv_catsv(sv1, sv2);
}
needlen = GetEnvironmentVariableA(name,NULL,0);
if (needlen != 0) {
- curitem = sv_2mortal(newSVpvn("", 0));
+ curitem = sv_2mortal(newSVpvs(""));
do {
SvGROW(curitem, needlen+1);
needlen = GetEnvironmentVariableA(name,SvPVX(curitem),
DllExport PerlIO*
win32_popenlist(const char *mode, IV narg, SV **args)
{
- Perl_croak_nocontext("List form of pipe open not implemented");
- return NULL;
-}
+ get_shell();
-/*
- * a popen() clone that respects PERL5SHELL
- *
- * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
- */
+ return do_popen(mode, NULL, narg, args);
+}
-DllExport PerlIO*
-win32_popen(const char *command, const char *mode)
-{
-#ifdef USE_RTL_POPEN
- return _popen(command, mode);
-#else
+STATIC PerlIO*
+do_popen(const char *mode, const char *command, IV narg, SV **args) {
int p[2];
int handles[3];
int parent, child;
int childpid;
DWORD nhandle;
int lock_held = 0;
+ const char **args_pvs = NULL;
/* establish which ends read and write */
if (strchr(mode,'w')) {
{
dTHX;
- if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
- goto cleanup;
+ if (command) {
+ if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
+ goto cleanup;
+
+ }
+ else {
+ int i;
+
+ Newx(args_pvs, narg + 1 + w32_perlshell_items, const char *);
+ SAVEFREEPV(args_pvs);
+ for (i = 0; i < narg; ++i)
+ args_pvs[i] = SvPV_nolen(args[i]);
+ args_pvs[i] = NULL;
+
+ if ((childpid = do_spawnvp_handles(P_NOWAIT, args_pvs[0], args_pvs, handles)) == -1) {
+ if (errno == ENOEXEC || errno == ENOENT) {
+ /* possible shell-builtin, invoke with shell */
+ Move(args_pvs, args_pvs+w32_perlshell_items, narg+1, const char *);
+ Copy(w32_perlshell_vec, args_pvs, w32_perlshell_items, const char *);
+ if ((childpid = do_spawnvp_handles(P_NOWAIT, args_pvs[0], args_pvs, handles)) == -1)
+ goto cleanup;
+ }
+ else
+ goto cleanup;
+ }
+ }
win32_close(p[child]);
win32_close(p[1]);
return (NULL);
+}
+/*
+ * a popen() clone that respects PERL5SHELL
+ *
+ * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
+ */
+
+DllExport PerlIO*
+win32_popen(const char *command, const char *mode)
+{
+#ifdef USE_RTL_POPEN
+ return _popen(command, mode);
+#else
+ return do_popen(mode, command, 0, NULL);
#endif /* USE_RTL_POPEN */
}
retval = -1;
}
}
-finish:
win32_lseek(fd, cur, SEEK_SET);
return retval;
#else
win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
{
#ifdef USE_RTL_SPAWNVP
- return spawnvp(mode, cmdname, (char * const *)argv);
+ return _spawnvp(mode, cmdname, (char * const *)argv);
#else
return do_spawnvp_handles(mode, cmdname, argv, NULL);
#endif
/* if this is a pseudo-forked child, we just want to spawn
* the new program, and return */
if (w32_pseudo_id)
- return spawnv(P_WAIT, cmdname, argv);
+ return _spawnv(P_WAIT, cmdname, argv);
#endif
- return execv(cmdname, argv);
+ return _execv(cmdname, argv);
}
DllExport int
return status;
}
#endif
- return execvp(cmdname, argv);
+ return _execvp(cmdname, argv);
}
DllExport void
unsigned short showwindow = w32_showwindow;
if (items > 1)
- Perl_croak(aTHX_ "usage: Win32::SetChildShowWindow($showwindow)");
+ croak_xs_usage(cv, "[showwindow]");
if (items == 0 || !SvOK(ST(0)))
w32_use_showwindow = FALSE;
* will not call mg_set() if it initializes %ENV from `environ`.
*/
SetEnvironmentVariableA("PATH", ansi_path+5);
- /* We are intentionally leaking the ansi_path string here because
- * the some runtime libraries puts it directly into the environ
- * array. The Microsoft runtime library seems to make a copy,
- * but will leak the copy should it be replaced again later.
- * Since this code is only called once during PERL_SYS_INIT this
- * shouldn't really matter.
- */
+ win32_free(ansi_path);
}
win32_free(wide_path);
}