virtual int Sleep(unsigned int) = 0;
virtual int Times(struct tms *timebuf) = 0;
virtual int Wait(int *status) = 0;
+ virtual int Waitpid(int pid, int *status, int flags) = 0;
virtual Sighandler_t Signal(int sig, Sighandler_t subcode) = 0;
#ifdef WIN32
virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr) = 0;
use Carp;
use Symbol 'qualify';
-$VERSION = 1.0101;
+$VERSION = 1.0102;
@ISA = qw(Exporter);
@EXPORT = qw(open3);
# &open3: Marc Horowitz <marc@mit.edu>
# derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
# fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
+# ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career
#
# $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
#
close $_[0] or croak "$Me: close($_[0]) failed: $!";
}
-my $do_spawn = $^O eq 'os2';
+my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32';
sub _open3 {
local $Me = shift;
$fd->{handle}->fdopen($saved{fileno $fd->{open_as}} || $fd->{open_as},
$fd->{mode});
}
- # Stderr may be redirected below, so we save the err text:
- foreach $fd (@$close_in_child) {
- fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
- unless $saved{fileno $fd}; # Do not close what we redirect!
+ unless ($^O eq 'MSWin32') {
+ # Stderr may be redirected below, so we save the err text:
+ foreach $fd (@$close_in_child) {
+ fcntl($fd, Fcntl::F_SETFD(), 1) or push @errs, "fcntl $fd: $!"
+ unless $saved{fileno $fd}; # Do not close what we redirect!
+ }
}
unless (@errs) {
#define PerlProc_sleep(t) piProc->Sleep((t))
#define PerlProc_times(t) piProc->Times((t))
#define PerlProc_wait(t) piProc->Wait((t))
+#define PerlProc_waitpid(p, s, f) piProc->Waitpid((p), (s), (f))
#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
#define PerlProc_signal(n, h) piProc->Signal((n), (h))
#define PerlProc_sleep(t) sleep((t))
#define PerlProc_times(t) times((t))
#define PerlProc_wait(t) wait((t))
+#define PerlProc_waitpid(p, s, f) waitpid((p), (s), (f))
#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
#define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
#define PerlProc_signal(n, h) signal((n), (h))
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
- unless ($Config{'d_fork'}) {
+ if (!$Config{'d_fork'}
+ # open2/3 supported on win32 (but not Borland due to CRT bugs)
+ && ($^O ne 'MSWin32' || $Config{'cc'} =~ /^bcc/i))
+ {
print "1..0\n";
exit 0;
}
print "ok $n\n";
}
else {
- print "not ok $n\n";
+ print "not ok $n\n";
print "# $info\n" if $info;
}
}
+sub cmd_line {
+ if ($^O eq 'MSWin32') {
+ return qq/"$_[0]"/;
+ }
+ else {
+ return $_[0];
+ }
+}
+
my ($pid, $reaped_pid);
STDOUT->autoflush;
STDERR->autoflush;
print "1..7\n";
-ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e', 'print scalar <STDIN>';
+ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e',
+ cmd_line('print scalar <STDIN>');
ok 2, print WRITE "hi kid\n";
-ok 3, <READ> eq "hi kid\n";
+ok 3, <READ> =~ /^hi kid\r?\n$/;
ok 4, close(WRITE), $!;
ok 5, close(READ), $!;
$reaped_pid = waitpid $pid, 0;
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
- unless ($Config{'d_fork'}) {
+ if (!$Config{'d_fork'}
+ # open2/3 supported on win32 (but not Borland due to CRT bugs)
+ && ($^O ne 'MSWin32' || $Config{'cc'} =~ /^bcc/i))
+ {
print "1..0\n";
exit 0;
}
print "ok $n\n";
}
else {
- print "not ok $n\n";
+ print "not ok $n\n";
print "# $info\n" if $info;
}
}
+sub cmd_line {
+ if ($^O eq 'MSWin32') {
+ my $cmd = shift;
+ $cmd =~ tr/\r\n//d;
+ $cmd =~ s/"/\\"/g;
+ return qq/"$cmd"/;
+ }
+ else {
+ return $_[0];
+ }
+}
+
my ($pid, $reaped_pid);
STDOUT->autoflush;
STDERR->autoflush;
print "1..21\n";
# basic
-ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', <<'EOF';
+ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
$| = 1;
print scalar <STDIN>;
print STDERR "hi error\n";
EOF
ok 2, print WRITE "hi kid\n";
-ok 3, <READ> eq "hi kid\n";
-ok 4, <ERROR> eq "hi error\n";
+ok 3, <READ> =~ /^hi kid\r?\n$/;
+ok 4, <ERROR> =~ /^hi error\r?\n$/;
ok 5, close(WRITE), $!;
ok 6, close(READ), $!;
ok 7, close(ERROR), $!;
ok 9, $? == 0, $?;
# read and error together, both named
-$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', cmd_line(<<'EOF');
$| = 1;
print scalar <STDIN>;
print STDERR scalar <STDIN>;
waitpid $pid, 0;
# read and error together, error empty
-$pid = open3 'WRITE', 'READ', '', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', 'READ', '', $perl, '-e', cmd_line(<<'EOF');
$| = 1;
print scalar <STDIN>;
print STDERR scalar <STDIN>;
# dup writer
ok 14, pipe PIPE_READ, PIPE_WRITE;
$pid = open3 '<&PIPE_READ', 'READ', '',
- $perl, '-e', 'print scalar <STDIN>';
+ $perl, '-e', cmd_line('print scalar <STDIN>');
close PIPE_READ;
print PIPE_WRITE "ok 15\n";
close PIPE_WRITE;
# dup reader
$pid = open3 'WRITE', '>&STDOUT', 'ERROR',
- $perl, '-e', 'print scalar <STDIN>';
+ $perl, '-e', cmd_line('print scalar <STDIN>');
print WRITE "ok 16\n";
waitpid $pid, 0;
# stdout but putting stdout somewhere else, is a good case because it
# used not to work.
$pid = open3 'WRITE', 'READ', '>&STDOUT',
- $perl, '-e', 'print STDERR scalar <STDIN>';
+ $perl, '-e', cmd_line('print STDERR scalar <STDIN>');
print WRITE "ok 17\n";
waitpid $pid, 0;
# dup reader and error together, both named
-$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', cmd_line(<<'EOF');
$| = 1;
print STDOUT scalar <STDIN>;
print STDERR scalar <STDIN>;
waitpid $pid, 0;
# dup reader and error together, error empty
-$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', <<'EOF';
+$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', cmd_line(<<'EOF');
$| = 1;
print STDOUT scalar <STDIN>;
print STDERR scalar <STDIN>;
if (!HAS_WAITPID_RUNTIME)
goto hard_way;
# endif
- return waitpid(pid,statusp,flags);
+ return PerlProc_waitpid(pid,statusp,flags);
#endif
#if !defined(HAS_WAITPID) && defined(HAS_WAIT4)
return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
get_specialsv_list(void)
{
return specialsv_list;
-}
\ No newline at end of file
+}
d_volatile='define'
d_vprintf='define'
d_wait4='undef'
-d_waitpid='undef'
+d_waitpid='define'
d_wcstombs='define'
d_wctomb='define'
d_xenix='undef'
d_volatile='define'
d_vprintf='define'
d_wait4='undef'
-d_waitpid='undef'
+d_waitpid='define'
d_wcstombs='define'
d_wctomb='define'
d_xenix='undef'
d_volatile='define'
d_vprintf='define'
d_wait4='undef'
-d_waitpid='undef'
+d_waitpid='define'
d_wcstombs='define'
d_wctomb='define'
d_xenix='undef'
* This symbol, if defined, indicates that the waitpid routine is
* available to wait for child process.
*/
-/*#define HAS_WAITPID /**/
+#define HAS_WAITPID /**/
/* HAS_WCSTOMBS:
* This symbol, if defined, indicates that the wcstombs routine is
#define LONGLONGSIZE 8 /**/
#endif
-/* HAS_MKSTEMP:
- * This symbol, if defined, indicates that the mkstemp routine is
- * available to create and open a unique temporary file.
- */
-/*#define HAS_MKSTEMP /**/
-
/* HAS_SETGROUPS:
* This symbol, if defined, indicates that the setgroups() routine is
* available to set the list of process groups. If unavailable, multiple
* This symbol, if defined, indicates that the waitpid routine is
* available to wait for child process.
*/
-/*#define HAS_WAITPID /**/
+#define HAS_WAITPID /**/
/* HAS_WCSTOMBS:
* This symbol, if defined, indicates that the wcstombs routine is
#define LONGLONGSIZE 8 /**/
#endif
-/* HAS_MKSTEMP:
- * This symbol, if defined, indicates that the mkstemp routine is
- * available to create and open a unique temporary file.
- */
-/*#define HAS_MKSTEMP /**/
-
/* HAS_SETGROUPS:
* This symbol, if defined, indicates that the setgroups() routine is
* available to set the list of process groups. If unavailable, multiple
* This symbol, if defined, indicates that the waitpid routine is
* available to wait for child process.
*/
-/*#define HAS_WAITPID /**/
+#define HAS_WAITPID /**/
/* HAS_WCSTOMBS:
* This symbol, if defined, indicates that the wcstombs routine is
#define LONGLONGSIZE 8 /**/
#endif
-/* HAS_MKSTEMP:
- * This symbol, if defined, indicates that the mkstemp routine is
- * available to create and open a unique temporary file.
- */
-/*#define HAS_MKSTEMP /**/
-
/* HAS_SETGROUPS:
* This symbol, if defined, indicates that the setgroups() routine is
* available to set the list of process groups. If unavailable, multiple
win32_ioctl
win32_utime
win32_wait
+win32_waitpid
+win32_kill
win32_str_os_error
Perl_win32_init
Perl_init_os_extras
};
virtual int Kill(int pid, int sig)
{
- return kill(pid, sig);
+ return win32_kill(pid, sig);
};
virtual int Killpg(int pid, int sig)
{
{
return win32_wait(status);
};
+ virtual int Waitpid(int pid, int *status, int flags)
+ {
+ return win32_waitpid(pid, status, flags);
+ };
virtual Sighandler_t Signal(int sig, Sighandler_t subcode)
{
return 0;
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
static char * get_emd_part(char *leading, char *trailing, ...);
+static void remove_dead_process(HANDLE deceased);
HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
static DWORD w32_platform = (DWORD)-1;
return 0;
}
-int
-kill(int pid, int sig)
+static void
+remove_dead_process(HANDLE deceased)
{
+#ifndef USE_RTL_WAIT
+ int child;
+ for (child = 0 ; child < w32_num_children ; ++child) {
+ if (w32_child_pids[child] == deceased) {
+ Copy(&w32_child_pids[child+1], &w32_child_pids[child],
+ (w32_num_children-child-1), HANDLE);
+ w32_num_children--;
+ break;
+ }
+ }
+#endif
+}
+
+DllExport int
+win32_kill(int pid, int sig)
+{
+#ifdef USE_RTL_WAIT
HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
+#else
+ HANDLE hProcess = (HANDLE) pid;
+#endif
if (hProcess == NULL) {
croak("kill process failed!\n");
if (!TerminateProcess(hProcess, sig))
croak("kill process failed!\n");
CloseHandle(hProcess);
+
+ /* WaitForMultipleObjects() on a pid that was killed returns error
+ * so if we know the pid is gone we remove it from process list */
+ remove_dead_process(hProcess);
}
return 0;
}
}
DllExport int
+win32_waitpid(int pid, int *status, int flags)
+{
+ int rc;
+ if (pid == -1)
+ return win32_wait(status);
+ else {
+ rc = cwait(status, pid, WAIT_CHILD);
+ /* cwait() returns differently on Borland */
+#ifdef __BORLANDC__
+ if (status)
+ *status = (((*status >> 8) & 0xff) | ((*status << 8) & 0xff00));
+#endif
+ remove_dead_process((HANDLE)pid);
+ }
+ return rc >= 0 ? pid : rc;
+}
+
+DllExport int
win32_wait(int *status)
{
#ifdef USE_RTL_WAIT
return _pclose(pf);
#else
-#ifndef USE_RTL_WAIT
- int child;
-#endif
-
int childpid, status;
SV *sv;
win32_fclose(pf);
SvIVX(sv) = 0;
-#ifndef USE_RTL_WAIT
- for (child = 0 ; child < w32_num_children ; ++child) {
- if (w32_child_pids[child] == (HANDLE)childpid) {
- Copy(&w32_child_pids[child+1], &w32_child_pids[child],
- (w32_num_children-child-1), HANDLE);
- w32_num_children--;
- break;
- }
- }
-#endif
+ remove_dead_process((HANDLE)childpid);
/* wait for the child */
if (cwait(&status, childpid, WAIT_CHILD) == -1)
DllExport int win32_ioctl(int i, unsigned int u, char *data);
DllExport int win32_utime(const char *f, struct utimbuf *t);
DllExport int win32_wait(int *status);
+DllExport int win32_waitpid(int pid, int *status, int flags);
+DllExport int win32_kill(int pid, int sig);
#ifdef HAVE_DES_FCRYPT
DllExport char * win32_crypt(const char *txt, const char *salt);
#define ioctl win32_ioctl
#define utime win32_utime
#define wait win32_wait
+#define waitpid win32_waitpid
+#define kill win32_kill
#ifdef HAVE_DES_FCRYPT
#undef crypt
projects / p5sagit/p5-mst-13.2.git / commitdiff