Read STDOUT from Win32::Job while process is running

[Dirk80]

Hello,

I've looked at this post and it is working fine: http://www.perlmonks.org/?node=471412.

I extended the example of BrowserUk so that I have a Cancel Button which then kills the process, but does not exit the application. And I have a start button which again starts it.

But to my problem. My process is unfortunately not that simple. It also creates subprocesses. Because I'm in a Win32 environment the only way I found to be sure that the process and its subprocesses are killed completely was to use Win32::Job.

But I don't know how to read from STDOUT while the process is running.

Here a code snippet without Win32::Job:

#!/usr/bin/perl

use strict;
use warnings;

$|=1;
open PROC, 
    'perl -le"$|=1; print and select(undef,undef,undef,0.1) for 1 .. 1
+000" |'
    or die $!;
while( <PROC> ) {
    print $_;
}
close PROC;

How could I do the same with Win32::Job? The run function is blocking, so I think that I have to use the watch function. But already at the spawning I don't know how to fill the option "stdout" and how then to capture the output of the process while it is running when I try it with Win32::Job.

So to summarize my problem. I'm here in a Win32 environment. I have to be able to kill a process tree. But I also want to read STDOUT from the created process while it is running. What are my options? My idea was to use Win32::Job because it is then very easy to kill the entire process tree. But this lead me to the problem that I don't know how to read the output while the process is running.

Thank you alot for your help.

[BrowserUk]

Win32::Job is fine when you don't need to do anything with the processes it spawns for you, but it limited otherwise.

The following Inline::C code will form a job from any pids you give, including those return by the forking open and system 1, ...; etc.

This example starts a perl one-liner that in turn start the windows calculator and notepad. 10 seconds after the jobs are started, they will disappear. The final sleep is there to show you that the closeHandle() worked:

#! perl -slw
use strict;
use Inline C => Config => BUILD_NOISY => 1;
use Inline C => <<'END_C',  NAME => 'JobObject', CLEAN_AFTER_BUILD => 
+0;

#include <windows.h>

int createJobObject( char *name ) {
    HANDLE job;
    JOBOBJECT_EXTENDED_LIMIT_INFORMATION jeli = { 0, };
    jeli.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_KILL_ON_J
+OB_CLOSE;
    job = (int)CreateJobObjectA( NULL, name );
    SetInformationJobObject( job, 9, &jeli, sizeof(jeli) );
    return job;
}

int assignProcessToJobObject( int job, int pid ) {
    HANDLE hProc = OpenProcess( PROCESS_SET_QUOTA |PROCESS_TERMINATE, 
+0, pid );
    return (int)AssignProcessToJobObject( job, hProc );
}

int closeHandle( int handle ) {
    return (int)CloseHandle( (HANDLE)handle );
}

END_C


my $job = createJobObject( 'fred' );
print $job;

my $pid = open O, q[\perl64\bin\perl.exe -E"system 1, 'calc.exe'; syst
+em 1, 'notepad.exe'; sleep 100" |] or die $^E;
print assignProcessToJobObject( $job, $pid );

sleep 10;

print closeHandle( $job );
# kill 21, $pid;

sleep 10

You call createJobObject() with a name to get a job handle; assignProcessToJobObject(), with that job handle and the pid for each process you want added to the job; and call closeHandle( $job ) when you want the job to terminate all the processes it includes.

You can also use kill on the process(es) you started and all their children will also die.

However, if you allow your script to end without killing the kids or closing the job handle, you process will block until the kids go away of their own accord.

That could probably be worked up into a module if there was any demand for it.

[Dirk80]

Thank you for that great answer. In theory I understand completely what your code is doing.

But my problem is that I don't get it running. I get the following messages:

Starting Build Preprocess Stage
Finished Build Preprocess Stage

Starting Build Parse Stage
Finished Build Parse Stage

Starting Build Glue 1 Stage
Finished Build Glue 1 Stage

Starting Build Glue 2 Stage
Finished Build Glue 2 Stage

Starting Build Glue 3 Stage
Finished Build Glue 3 Stage

Starting Build Compile Stage
  Starting "perl Makefile.PL" Stage
Set up gcc environment - 3.4.5 (mingw-vista special r3)
Writing Makefile for JobObject
  Finished "perl Makefile.PL" Stage

  Starting "make" Stage
warning: extra args ignored after '-e'

And then the script continues running endlessly without starting any processes.

When I tried it with the debugger I could not even reach the first perl statement and got the same messages.

When your code is running here on my computer, I'd like to put your code into a module and then post it here.

I ask myself if I'm doing weird things because nobody seems to need this functionality. I would assume that many people would need this useful functionality.

Thank you alot.

[syphilis]

warning: extra args ignored after '-e'

This warning doesn't ring any bells with me.
How did you install Inline ? (You need to build and install it from source - eg doing a 'ppm install' won't do.)
Knowing the output of 'perl -V' would also help - as, too, would knowing any additional diagnostics that you're getting.

The code, as posted by BrowserUk, won't compile for me using the MinGW port of gcc-3.4.5, because of a deficiency in winnt.h.
In that file you'll need to add:

#define JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE          0x2000

For some reason (that I haven't yet investigated), with ActivePerl I then get undefined references to `CreateJobObjectA', `SetInformationJobObject', `AssignProcessToJobObject' - which is odd, because these symbols are all defined in libbkernel32.a and we link to that library. (It may just be that we need to link to libkernel32.a *before* JobObject.o.)
Anyway, if you get to the same snag we can dig a bit deeper then.
First we need to work out what that warning is all about.

Cheers,
Rob

[BrowserUk]

I can't help you with I::C on mingw. Hopefully, syphilis will wander by sometime.

In the meantime, I've built a crude package -- no docs or tests etc. -- from the 3 functions. It builds and runs here. If you give me your mail addy (via /msg) I'll send you the dist.