| Subject: | Patch to merge Wheel::Run::Win32 into Wheel::Run |
The attached patch Merges POE::Wheel::Run::Win32 into POE::Wheel::Run.
All tests passed on linux.
The patch works on win32, but I needed to back out r2628. r2628 touches
different files, but changes something that causes perl to crash
abruptly on win32.
This patch does not include backing out r2628.
It would be nice if there where tests to test for the reason for these
changes, but I couldn't find any in Run::Win32. I settled for passing
POE's test suite and "works for me"
| Subject: | merge_run_runwin32.patch |
Index: lib/POE/Wheel/Run.pm
===================================================================
--- lib/POE/Wheel/Run.pm (revision 2700)
+++ lib/POE/Wheel/Run.pm (working copy)
@@ -34,6 +34,15 @@
eval { require Win32API::File; };
if ($@) { die "Win32API::File but failed to load:\n$@" }
else { Win32API::File->import( qw(FdGetOsFHandle) ); };
+
+ eval { require Win32::Process; };
+ if ($@) { die "Win32::Process but failed to load:\n$@" }
+
+ eval { require Win32::Job; };
+ if ($@) { die "Win32::Job but failed to load:\n$@" }
+
+ eval { require Win32; };
+ if ($@) { die "Win32 but failed to load:\n$@" }
}
# Determine the most file descriptors we can use.
@@ -76,6 +85,8 @@
sub EVENT_STDERR () { 23 }
sub STATE_STDERR () { 24 }
+sub MSWIN32_GROUP_PID () { 25 }
+
# Used to work around a bug in older perl versions.
sub CRIMSON_SCOPE_HACK ($) { 0 }
@@ -387,8 +398,10 @@
# Tell the parent that the stdio has been set up.
close $sem_pipe_read;
- print $sem_pipe_write "go\n";
- close $sem_pipe_write;
+ unless ( ref($program) ne 'CODE' and POE::Kernel::RUNNING_IN_HELL ) {
+ print $sem_pipe_write "go\n";
+ close $sem_pipe_write;
+ }
if (POE::Kernel::RUNNING_IN_HELL) {
# The Win32 pseudo fork sets up the std handles in the child
@@ -442,10 +455,54 @@
eval { exec("$^X -e 0"); };
};
exit(0);
- }
- else {
+ } else {
# Windows! What I do for you!
if (POE::Kernel::RUNNING_IN_HELL) {
+ my $exitcode = 0;
+
+ my ($appname, $cmdline);
+
+ if (ref $program eq 'ARRAY') {
+ $appname = $program->[0];
+ $cmdline = join(' ', map { /\s/ && ! /"/ ? qq{"$_"} : $_ } (@$program, @$prog_args) );
+ }
+ else {
+ $appname = undef;
+ $cmdline = join(' ', $program, map { /\s/ && ! /"/ ? qq{"$_"} : $_ } @$prog_args);
+ }
+
+ my $w32job;
+
+ unless ( $w32job = Win32::Job->new() ) {
+ print $sem_pipe_write "go\n";
+ close $sem_pipe_write;
+ die Win32::FormatMessage( Win32::GetLastError() );
+ }
+
+ my $w32pid;
+
+ unless ( $w32pid = $w32job->spawn( $appname, $cmdline ) ) {
+ print $sem_pipe_write "go\n";
+ close $sem_pipe_write;
+ die Win32::FormatMessage( Win32::GetLastError() );
+ }
+ else {
+ print $sem_pipe_write "$w32pid\n";
+ close $sem_pipe_write;
+ my $ok = $w32job->watch( sub { 0 }, 60 );
+ my $hashref = $w32job->status();
+ $exitcode = $hashref->{$w32pid}->{exitcode};
+ }
+
+ # In case flushing them wasn't good enough.
+ close STDOUT if defined fileno(STDOUT);
+ close STDERR if defined fileno(STDERR);
+
+ exit($exitcode);
+ }
+
+ # Windows! What I do for you!
+ if (POE::Kernel::RUNNING_IN_HELL) {
if (ref($program) eq 'ARRAY') {
exec(@$program, @$prog_args);
warn "can't exec (@$program) in child pid $$: $!";
@@ -519,6 +576,7 @@
$stderr_driver, # DRIVER_STDERR
$stderr_event, # EVENT_STDERR
undef, # STATE_STDERR
+ undef, # MSWIN32_GROUP_PID
], $type;
# PG- I suspect <> might need PIPE
@@ -526,7 +584,9 @@
# Wait here while the child sets itself up.
{
local $/ = "\n";
- <$sem_pipe_read>;
+ my $chldout = <$sem_pipe_read>;
+ chomp $chldout;
+ $self->[MSWIN32_GROUP_PID] = $chldout if POE::Kernel::RUNNING_IN_HELL and $chldout ne 'go';
}
close $sem_pipe_read;
close $sem_pipe_write;
@@ -1106,7 +1166,12 @@
sub kill {
my ($self, $signal) = @_;
$signal = 'TERM' unless defined $signal;
- eval { kill $signal, $self->[CHILD_PID] };
+ if ( $self->[MSWIN32_GROUP_PID] ) {
+ Win32::Process::KillProcess( $self->[MSWIN32_GROUP_PID], 293 );
+ }
+ else {
+ eval { kill $signal, $self->[CHILD_PID] };
+ }
}
1;