Wed Mar 25 14:50:19 2009: Request 44573 was acted upon.
Transaction: Ticket created by yulmathieu
Queue: Win32-Process
Subject: Patch to add stdin/stdout/stderr redirection at process creation
Broken in: 0.14
Severity: Normal
Owner: Nobody
Requestors: math...@closetwork.org
Status: new
Ticket <URL: https://rt.cpan.org/Ticket/Display.html?id=44573 >
This patch adds three optional parameters to CreateProcess,
$stdin,$stdout,$stderr, which can be used to redirect the process's
output. A bit like Win32::Job.
Index: C:/Documents and Settings/mlongtin/My
Documents/dbpro/svn/branches/mlongtin/Win32-Process-0.14/Process.hpp
===================================================================
--- C:/Documents and Settings/mlongtin/My
Documents/dbpro/svn/branches/mlongtin/Win32-Process-0.14/Process.hpp
(revision 412)
+++ C:/Documents and Settings/mlongtin/My
Documents/dbpro/svn/branches/mlongtin/Win32-Process-0.14/Process.hpp
(revision 413)
@@ -26,7 +26,8 @@
BOOL bRetVal;
cProcess(char* szAppName, char* szCommLine, BOOL Inherit,
- DWORD CreateFlags, void *env, char* szCurrDir)
+ DWORD CreateFlags, void *env, char* szCurrDir,
+ HANDLE hStdin, HANDLE hStdout, HANDLE hStderr)
{
STARTUPINFOA st;
PROCESS_INFORMATION procinfo;
@@ -41,6 +42,10 @@
ph = NULL;
th = NULL;
+ if ( hStdin ) { st.hStdInput = hStdin; st.dwFlags |=
STARTF_USESTDHANDLES; }
+ if ( hStdout ) { st.hStdOutput = hStdout; st.dwFlags |=
STARTF_USESTDHANDLES; }
+ if ( hStderr ) { st.hStdError = hStderr; st.dwFlags |=
STARTF_USESTDHANDLES; }
+
bRetVal = CreateProcessA(szAppName,szCommLine,NULL,NULL,
Inherit,CreateFlags,env,szCurrDir,
&st,&procinfo);
Index: C:/Documents and Settings/mlongtin/My
Documents/dbpro/svn/branches/mlongtin/Win32-Process-0.14/Process.xs
===================================================================
--- C:/Documents and Settings/mlongtin/My
Documents/dbpro/svn/branches/mlongtin/Win32-Process-0.14/Process.xs
(revision 412)
+++ C:/Documents and Settings/mlongtin/My
Documents/dbpro/svn/branches/mlongtin/Win32-Process-0.14/Process.xs
(revision 413)
@@ -24,7 +24,7 @@
static BOOL
Create(cProcess* &cP, char* szAppName, char* szCommLine, DWORD Inherit,
- DWORD CreateFlags, char* szCurrDir)
+ DWORD CreateFlags, char* szCurrDir, HANDLE hStdin, HANDLE
hStdout, HANDLE hStderr)
{
BOOL bRetVal;
void *env = NULL;
@@ -34,7 +34,7 @@
cP = NULL;
try {
cP = (cProcess*)new cProcess(szAppName,szCommLine,Inherit,CreateFlags,
- env,szCurrDir);
+ env,szCurrDir, hStdin, hStdout,
hStderr);
bRetVal = cP->bRetVal;
}
catch (...) {
@@ -283,6 +283,80 @@
return 0;
}
+/* Called to remember/close files created with CreateFile */
+static SV*
+new_handle(pTHX_ HANDLE file)
+{
+ SV* rv = newSViv(0); /* blank SV */
+ sv_setref_iv(rv, "Win32::Job::_handle", PTR2IV(file));
+ return rv;
+}
+
+/* This function checks an SV* to see if it contains an IO* structure. This
+ * code is taken from sv.c's sv_2io(). Unfortunately, *that* code throws
+ * exceptions, and I just want to know if it will work or not, without
having
+ * to set up a new frame. */
+static int /* bool */
+sv_isio(pTHX_ SV *sv)
+{
+ IO *io;
+ GV *gv;
+ STRLEN n_a;
+
+ switch (SvTYPE(sv)) {
+ case SVt_PVIO:
+ io = (IO*)sv;
+ return 1;
+ case SVt_PVGV:
+ gv = (GV*)sv;
+ io = GvIO(gv);
+ if (!io)
+ return 0;
+ return 1;
+ default:
+ if (!SvOK(sv))
+ return 0;
+ if (SvROK(sv))
+ return sv_isio(aTHX_ SvRV(sv));
+ gv = gv_fetchpv(SvPV(sv,n_a), FALSE, SVt_PVIO);
+ if (gv)
+ return 1;
+ else
+ return 0;
+ }
+ return 0;
+}
+
+static HANDLE
+sv_convert_stdio(pTHX_ SV *handle_or_filename, AV *files)
+{
+ HANDLE hResult;
+ if (sv_isio(aTHX_ handle_or_filename)) {
+ int fd = PerlIO_fileno(IoIFP(sv_2io(handle_or_filename)));
+ hResult = (HANDLE)win32_get_osfhandle(fd);
+ }
+ else if ( SvOK(handle_or_filename) ) {
+ hResult = CreateFile(
+ SvPV_nolen(handle_or_filename),
+ GENERIC_READ,
+ FILE_SHARE_READ,
+ NULL, /* safe on W2K and XP */
+ OPEN_EXISTING,
+ FILE_ATTRIBUTE_NORMAL,
+ NULL
+ );
+ if (hResult == INVALID_HANDLE_VALUE)
+ croak("Invalid handle.");
+ av_push(files, new_handle(aTHX_ hResult));
+ } else {
+ return NULL;
+ }
+ SetHandleInformation(hResult, HANDLE_FLAG_INHERIT,
+ HANDLE_FLAG_INHERIT);
+ return hResult;
+}
+
+
#if defined(__cplusplus)
}
#endif
@@ -294,15 +368,31 @@
BOOL
-Create(cP,appname,cmdline,inherit,flags,curdir)
+Create(cP,appname,cmdline,inherit,flags,curdir,...)
cProcess *cP = NULL;
char *appname
char *cmdline
BOOL inherit
DWORD flags
char *curdir
+PREINIT:
+ HANDLE hStdin = NULL;
+ HANDLE hStdout = NULL;
+ HANDLE hStderr = NULL;
+ AV * files;
CODE:
- RETVAL = Create(cP, appname, cmdline, inherit, flags, curdir);
+ files = (AV*)sv_2mortal((SV*)newAV());
+
+ if (items >= 7) {
+ hStdin = sv_convert_stdio(aTHX_ ST(6), files);
+ }
+ if (items >= 8) {
+ hStdout = sv_convert_stdio(aTHX_ ST(7), files);
+ }
+ if (items >= 9) {
+ hStderr = sv_convert_stdio(aTHX_ ST(8), files);
+ }
+ RETVAL = Create(cP, appname, cmdline, inherit, flags,
curdir,hStdin, hStdout, hStderr);
OUTPUT:
cP
RETVAL
Index: C:/Documents and Settings/mlongtin/My
Documents/dbpro/svn/branches/mlongtin/Win32-Process-0.14/Process.pm
===================================================================
--- C:/Documents and Settings/mlongtin/My
Documents/dbpro/svn/branches/mlongtin/Win32-Process-0.14/Process.pm
(revision 412)
+++ C:/Documents and Settings/mlongtin/My
Documents/dbpro/svn/branches/mlongtin/Win32-Process-0.14/Process.pm
(revision 413)
@@ -97,7 +97,7 @@
=over 8
-=item
Win32::Process::Create($obj,$appname,$cmdline,$iflags,$cflags,$curdir)
+=item
Win32::Process::Create($obj,$appname,$cmdline,$iflags,$cflags,$curdir,[$stdin,$stdout,$stderr])
Creates a new process.
@@ -109,9 +109,14 @@
$iflags flag: inherit calling processes handles or not
$cflags flags for creation (see exported vars below)
$curdir working dir of new process
+ $stdin Filehandle for standard input. Optional.
+ $stdout Filehandle for standard output. Optional.
+ $stderr Filehandle for standard error. Optional.
Returns non-zero on success, 0 on failure.
+If any of $stdin, $stdout or $stderr are skipped, or set to B<undef>,
the parent's filehandle is inherited.
+
=item Win32::Process::Open($obj,$pid,$iflags)
Creates a handle Perl can use to an existing process as identified by $pid.
