Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Re^5: Read STDOUT from Win32::Job while process is running

by BrowserUk (Pope)
on Mar 11, 2012 at 12:35 UTC ( #958937=note: print w/replies, xml ) Need Help??


in reply to Re^4: Read STDOUT from Win32::Job while process is running
in thread Read STDOUT from Win32::Job while process is running

Well ... I investigated and investigated ... then investigated a bit more ... and still couldn't see what the problem was. So I then gave up and posted to the ActiveState users list - and about half an hour later Mark Dootson replied with the explanation and solution.

Well done and thank you.++

Rather than requiring the Perl sources modification -- which might be needed by something somewhere -- adding the define before the inclusion of the Perl headers achieves the same thing in a self-contained way. I've also cleaned up a couple of the warnings -- though traded them for others in some cases, but I'm not sure there is a better way?

The result looks like this:

#define _WIN32_WINNT 0x0500 #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #ifndef JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE #define JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE 0x2000 #endif int createJobObject( char *name ) { HANDLE job; JOBOBJECT_EXTENDED_LIMIT_INFORMATION jeli = { 0, }; jeli.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_KILL_ON_J +OB_CLOSE; job = CreateJobObjectA( NULL, name ); SetInformationJobObject( job, 9, &jeli, sizeof(jeli) ); return (int)job; } int assignProcessToJobObject( int job, int pid ) { HANDLE hProc = OpenProcess( PROCESS_SET_QUOTA |PROCESS_TERMINATE, +0, pid ); return (int)AssignProcessToJobObject( (HANDLE)job, hProc ); } int closeHandle( int handle ) { return (int)CloseHandle( (HANDLE)handle ); } MODULE = Win32::JobAdd PACKAGE = Win32::JobAdd int createJobObject (name) char * name int assignProcessToJobObject (job, pid) int job int pid int closeHandle (handle) int handle

Salient part of the build trace:

JobAdd.c JobAdd.xs(18) : warning C4311: 'type cast' : pointer truncation from ' +HANDLE' to 'int' JobAdd.xs(24) : warning C4312: 'type cast' : conversion from 'int' to +'HANDLE' of greater size JobAdd.xs(28) : warning C4312: 'type cast' : conversion from 'int' to +'HANDLE' of greater size link -out:blib\arch\auto\Win32\JobAdd\JobAdd.dll -dll -nologo +-nodefaultlib -debug -opt:ref,icf -ltcg ... Creating library blib\arch\auto\Win32\JobAdd\JobAdd.lib and object +blib\arch\auto\Win32\JobAdd\JobAdd.exp

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?

Replies are listed 'Best First'.
Re^6: Read STDOUT from Win32::Job while process is running
by syphilis (Bishop) on Mar 11, 2012 at 23:40 UTC
    adding the define before the inclusion of the Perl headers achieves the same thing in a self-contained way

    Yes - I was looking at the Inline::C approach which, afaik, doesn't provide that option - it always inserts the inclusion of perl.h and friends *before* any C code that the author of the script provides.

    Hmm ... maybe Inline::C should provide an option that allows one to place C code ahead of those inclusions. (TODO ?)

    In this particular instance I think that modifying CORE/win32.h should be safe (no guarantees, but :-) - so long as you're running on XP or higher.
    After all, if CORE/win32.h did its job properly I think it would assign the actual value associated with the OS on which perl was running, not just provide a minimum supported value.

    Cheers,
    Rob
      Hmm ... maybe Inline::C should provide an option that allows one to place C code ahead of those inclusions. (TODO ?)

      I wonder if, in this case, it wouldn't be possible to pass a -D_WIN32_WINNT=0x0500 to the compiler CCFLAGS?

      After all, if CORE/win32.h did its job properly I think it would assign the actual value associated with the OS on which perl was running, not just provide a minimum supported value.

      Agreed. But the whole (MS) concept of a define that you specify to say that you want at least version x.xxx, then preventing anything later than version x.xx being included, is a weird way to write header files.

      As you say, the best solution to the problem that creates, would be for win32.h to define it to be "the current OS version" at compile time, but I can't find a ready source for that information amongst the MSC pre-defines.


      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

      The start of some sanity?

        I wonder if, in this case, it wouldn't be possible to pass a -D_WIN32_WINNT=0x0500 to the compiler CCFLAGS?

        Yes - that works for this case. (I didn't think of doing that.)
        There are, I think, (hypothetical) situations where that approach would be found wanting - eg if the define depended upon what else is defined (#ifdef/#else/#endif), or if you need to include a header.

        I can't find a ready source for that information amongst the MSC pre-defines

        I can't either - it may not exist. The only way I know of is GetOSVersion().

        Cheers,
        Rob
Re^6: SOLUTION: Read STDOUT from child process and kill process tree
by Dirk80 (Pilgrim) on Mar 12, 2012 at 16:40 UTC

    Thanks again to all of you helping me so much.

    Here I want to post the solution of my original problem.

    #!/usr/bin/perl use strict; use threads; use Thread::Queue; use Win32::JobAdd; ## A shared var to communicate progess between work thread and TK my $Q = new Thread::Queue; my $job:shared = createJobObject( 'counter_and_calc_job' ); sub work{ my $pid = open PROC, q[perl -le "$|=1; system 1, 'calc.exe'; print and select(undef,und +ef,undef,0.1) for 1 .. 1000" |] or die $!; assignProcessToJobObject( $job, $pid ); while( <PROC> ) { $Q->enqueue( $_ ); } close PROC; } threads->new( \&work )->detach; ## For lowest memory consumption require (not use) ## Tk::* after you've started the work thread. require Tk::ProgressBar; my $mw = MainWindow->new; my $pb = $mw->ProgressBar()->pack(); my $button = $mw->Button(-text => 'CANCEL', -command => sub { closeHandle( $job ) } )->pa +ck(); 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->MainLoop;

    This code solves my two problems. Being able to read from a child process, but also being able to kill the whole process tree instead of only killing the child process and to have zombie processes.

    If you press the "Cancel" Button then the calculator and the child process which counts from 1 to 1000 are killed. Even if you quit the gui with the cross in the right upper corner the grandchild process "calculator" is killed.

    Without a job environment in a Win32 environment the grandchild calculator would stay as a zombie process.

    Feedback to this code is welcome.

    Cheers, Dirk

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://958937]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (2)
As of 2021-11-28 07:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?