in reply to Suspend/Resume a process from Tk GUI in Windows XP
This works! The only real change I've made is to ensure that the 'destringification' of the process object only happens once:
$ProcessObj ||= eval($ProcessObj_as_string);
Why it works is still something of a mystery to me, but maybe it will help you forward with your investigations.
To understand why I tried it, try running your original code, but immediately suspend the child using the Process Explorer, then you'll find that the resume will work via your Tk interface. Exactly once.#!perl -slw use strict; use threads; use threads::shared; use Thread::Queue; use Win32::Process; use Win32; use Data::Dumper; sub ErrorReport { print Win32::FormatMessage( Win32::GetLastError() ); + } ## A shared var to communicate progess between work thread and TK my $Q = new Thread::Queue; my $ProcessObj_as_string:shared; my $ProcessObj; sub work{ # save STDOUT open(my $STDOUT_ORIG, ">&", \*STDOUT) or die; # connect TO_CHILD_PROC with CHILD_PROC pipe(CHILD_PROC, TO_CHILD_PROC); # change STDOUT to TO_CHILD_PROC # --> STDOUT of child process is set to TO_CHILD_PROC and # this is connected via pipe with CHILD_PROC open(STDOUT, ">&", \*TO_CHILD_PROC); Win32::Process::Create( $ProcessObj, "C:\\Perl32\\bin\\perl.exe", "perl child.pl", 1, NORMAL_PRIORITY_CLASS, "." )|| die "$! : $^E"; warn "$ProcessObj $$ProcessObj"; $ProcessObj_as_string = Dumper($ProcessObj); # restore STDOUT open(STDOUT, ">&", $STDOUT_ORIG) or die; while( <CHILD_PROC> ) { chomp($_); $Q->enqueue( $_ ); } close( CHILD_PROC ); } threads->new( \&work )->detach; use Tk; use Tk::ProgressBar; my $mw = MainWindow->new; my $pb = $mw->ProgressBar()->pack(); my $repeat; $repeat = $mw->repeat( 100 => sub { while( $Q->pending ) { my $progress = $Q->dequeue; return unless $progress; $repeat->cancel if $progress == 100; $pb->value( $progress ); } } ); $mw->Button( '-text' => 'Cancel', '-command' => sub { my $VAR1; $ProcessObj ||= eval($ProcessObj_as_string); warn "$ProcessObj $$ProcessObj"; $ProcessObj->Kill(0); exit 0; } )->pack(); $mw->Button( '-text' => 'Suspend', '-command' => sub { my $VAR1; $ProcessObj ||= eval($ProcessObj_as_string); warn "$ProcessObj $$ProcessObj"; $ProcessObj->Suspend(); } )->pack(); $mw->Button( '-text' => 'Resume', '-command' => sub { my $VAR1; $ProcessObj ||= eval($ProcessObj_as_string); warn "$ProcessObj $$ProcessObj"; $ProcessObj->Resume(); } )->pack(); $mw->MainLoop;
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: Suspend/Resume a process from Tk GUI in Windows XP
by Dirk80 (Pilgrim) on Feb 18, 2011 at 16:22 UTC | |
by BrowserUk (Patriarch) on Feb 18, 2011 at 17:02 UTC | |
by Dirk80 (Pilgrim) on Feb 18, 2011 at 23:48 UTC | |
by BrowserUk (Patriarch) on Feb 19, 2011 at 00:22 UTC |