| Subject: | POE::Wheel::Run/Tk/MSWin32 Problem |
This issue was discussed at http://www.perlmonks.org/?node_id=787371
The attached program works under both Unix and windows as expected.
To make it work under windows (ActiveState perl), I had to run the command "dir & pause",
otherwise the Tk window will go away (I want it to stick around until the user deletes it).
It should have worked by just running the "dir" command, because I put in "postback('DontDie')"
to prevent the Tk window from being shut down. Using POE::Wheel::Run::Win32 doesn't seem to
help, as it burps up an "ERR: Free to wrong pool" message.
After some discussion, Rocco asked me to submit this bug report.
-Craig
| Subject: | tst00.pl |
use English;
use strict;
use warnings;
use Tk;
use POE;
use POE::Wheel::Run;
# Setup program to run...
my $PGM = 'ls';
if ($OSNAME eq 'MSWin32') { $PGM = 'dir & pause' };
#if ($OSNAME eq 'MSWin32') { $PGM = 'dir' }; # This doesn't work!
print STDERR "$OSNAME PGM=$PGM\n";
my $TEXT; # Global for text widget...
# Setup POE session...
my $session = _poeSetup();
# Create dummy postback so the session won't die once input is done...
my $subref = $session->postback('DontDie');
# Go...
$poe_kernel->run();
#################
# POE Subroutines
#################
sub _poeSetup {
my $session = POE::Session->create(
inline_states=>{
_start => \&_startUp,
KidOut => \&_GetStdout,
KidErr => \&_GetStderr,
KidClose => \&_DoClose,
},
);
return($session);
}
# POE Session Supporting Routines...
sub _startUp {
$TEXT=$poe_main_window->Scrolled('Text', -wrap=>'none')->pack;
$poe_main_window->update;
my $child = POE::Wheel::Run->new(
Program => $PGM,
StdoutEvent => 'KidOut',
StderrEvent => 'KidErr',
CloseEvent => 'KidClose',
);
$_[KERNEL]->sig_child($child->PID, '_DoSig');
$_[HEAP]{Kids}{WID}{$child->ID} = $child;
$_[HEAP]{Kids}{PID}{$child->PID} = $child;
}
sub _GetStdout {
my ($line, $wid) = @_[ARG0, ARG1];
my $child = $_[HEAP]{Kids}{WID}{$wid};
$TEXT->insert('end', $child->PID . " OUT: $line\n");
$TEXT->see('end');
$poe_main_window->update;
}
sub _GetStderr {
my ($line, $wid) = @_[ARG0, ARG1];
my $child = $_[HEAP]{Kids}{WID}{$wid};
$TEXT->insert('end', $child->PID . " ERR: $line\n");
$TEXT->see('end');
$poe_main_window->update;
}
sub _DoClose {
my $wid = $_[ARG0];
my $child = $_[HEAP]{Kids}{WID}{$wid};
unless (defined $child) {
print STDERR "wid $wid closed all pipes.\n";
return;
}
print STDERR "wid $wid closed all pipes.\n";
delete $_[HEAP]{Kids}{PID}{$child->PID};
}
sub _DoSig {
print STDERR "pid $_[ARG1] exited with status $_[ARG2].\n";
my $child = delete $_[HEAP]{Kids}{PID}{$_[ARG1]};
return unless defined $child;
delete $_[HEAP]{Kids}{WID}{$child->ID};
}