Skip Menu |

This queue is for tickets about the Win32-Process CPAN distribution.

Report information
The Basics
Id: 44573
Status: new
Priority: 0/
Queue: Win32-Process

People
Owner: Nobody in particular
Requestors: mathieu [...] closetwork.org
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 0.14
Fixed in: (no value)



Subject: Patch to add stdin/stdout/stderr redirection at process creation
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.