Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
Monks,

I am looking for a method to fork a child process (the command string is passed in), capture the status to report complete/not_complete, and also provide a mechanism to abort the process.

I have come up with 2 forked processes, one for the passed in command, and another for the abort prompt. If the command completes, it kills the abort prompt. If the user selects the abort prompt, the command process is killed. My only problem at this point is to capture the status of the command when it is allowed to complete (which was not a problem before I added the abort prompt).

I realize that the child process is a copy of the parent, and does not share variable space. What is the best way for the parent to capture the status from the child?

I have condensed the problem in my code: (The target is a Perl/TK program, so the abort prompt will be done in TK.) I will also attach a sample command to show intended command status options.

Thanks in advance.

For reference, I have updated the program to show a working example. Thanks for the help.

#!/usr/bin/perl5.87 -w use strict; use POSIX ":sys_wait_h"; # For WNOHANG FLAG in waitpid use Carp; use Proc::Killfam; execute_script(); print "############################\n"; print "## Program EXIT ##\n"; print "############################\n"; ###################################################################### +## # End of main program ###################################################################### +## sub execute_script { my $DEBUG = 1; my $process_id; my $kill_proc_id; my $ret; my $full_cmd = "prompt.pl"; if ($DEBUG) {print "1:Running Execute Script PPID# $$\n";} ################################### # Fork the script command child ################################### if ($process_id = fork) { # Parent process if ($DEBUG) {print "2:CMD Parent START PPID# $$, CPID(CMD)# $p +rocess_id\n";} } elsif ($process_id == 0) { ################################ # Script Command Child process ################################ if ($DEBUG) {print "3:CMD Child START-running CMD. CPID(CMD)# +$$\n";} # exec needed so as to not consume status for $? later exec("prompt.pl"); # Need exit in Child process (never reaches here) exit(0); } else { print "Can't fork for CMD Child: $!\n"; } if ($DEBUG) {sleep(1);} # Just to order debug messages ################################### # Fork the kill prompt child ################################### if ($kill_proc_id = fork) { # Parent process if ($DEBUG) {print "4:Kill Parent START PPID# $$, CPID(kill)# +$kill_proc_id\n";} } elsif ($kill_proc_id == 0) { ############################# # Kill prompt Child process ############################# if ($DEBUG) {print "5:Kill Child START-waiting for 'k' command +. CPID(CMD)# $process_id, CPID(kill)# $$\n";} # Wait for user input to kill script command child my $cget = getc; while ($cget ne 'k') { } if ($DEBUG) {print "\t5-Kill CMD Child now - ABORT BUTTON ACQK +NOWLEDGED\n";} killfam '2',($process_id); sleep 1; # Required - do not remove unless (waitpid($process_id, WNOHANG)) { if ($DEBUG) {print "\t5-Kill CMD Child w/INT did not work. +\n";} killfam '1',($process_id); sleep 1; unless (waitpid($process_id, WNOHANG)) { if ($DEBUG) {print "\t5-Kill CMD Child w/HUP did not w +ork.\n";} killfam '15',($process_id); sleep 1; unless (waitpid($process_id, WNOHANG)) { if ($DEBUG) {print "\t5-Kill CMD Child w/TERM did +not work.\n";} killfam '9',($process_id); sleep 1; unless (waitpid($process_id, WNOHANG)) { print "Could not kill CPID#:$process_id w/KIL +L\n"; } } } } if ($DEBUG) {print "\t5-Kill Child EXIT\n";} # Need exit in Child process exit(0); } else { if ($DEBUG) {print "Can't fork for Kill Child: $!\n";} } if ($DEBUG) {sleep(1);} # Just to order debug messages if ($DEBUG) {print "6:After Forks: PPID# $$\n";} ############################################## # Parent waits for script to end or be killed ############################################## waitpid($process_id, 0); if ($DEBUG) {print "7:Process $process_id terminated\n";}; $ret = $?; if ($DEBUG) {print "8:Kill Kill Process $kill_proc_id\n";} # kill w/INT (2) never works killfam '1',($kill_proc_id); sleep 1; # Required - do not remove unless (waitpid($kill_proc_id, WNOHANG)) { if ($DEBUG) {print "\t8-Kill Kill Child w/HUP did not work.\n" +;} killfam '15',($kill_proc_id); sleep 1; # Required - do not remove unless (waitpid($kill_proc_id, WNOHANG)) { if ($DEBUG) {print "\t8-Kill Kill Child w/TERM did not wor +k.\n";} killfam '9',($kill_proc_id); sleep 1; # Required - do not remove unless (waitpid($kill_proc_id, WNOHANG)) { print "Could not kill CPID#:$kill_proc_id w/KILL\n"; } } } if (defined $ret) { my $ret1 = $ret >> 8; if ($DEBUG) {print "Return value:$ret,$ret1\n";} if ($ret1 == 1) { if ($DEBUG) {print "PASS\n";} } else { if ($DEBUG) {print "FAIL\n";} } return $ret1; } else { if ($DEBUG) {print "Return value not set. Last exit status:$?\ +n";} } return(0); }
Here is my example command, "prompt.pl", with return status:
#!/usr/bin/perl5.87 -w # ================================================================== # Prompt # GUI to ask user to confirm an action. # ================================================================== use strict; use Tk; if (defined $ARGV[0]) { $0 =~ s/.pl$//; die "Confirm:\n". "Useage: $0\n"; } my $GUI; my $mw; my $message = "Please verify that the task is complete."; $mw = MainWindow->new(-title => 'Confirm'); $mw->minsize('50','50'); $mw->protocol('WM_DELETE_WINDOW' => sub {print "0"; exit(0);}); my $bf = $mw->Frame->pack(qw/-side bottom -fill x/); $mw->Message(-text => $message, -width => 600) ->pack(qw/-anchor center -side top -fill x -expand 1/); $bf->Button(-text => 'NOT COMPLETE', -command => sub {exit(0);}) ->pack(qw/-side left -fill x -expand 1/); $bf->Button(-text => 'COMPLETE', -command => sub {exit(1);}) ->pack(qw/-side left -fill x -expand 1/); $mw->Popup; MainLoop; ############################################################## # End of main program ##############################################################

In reply to How to optionally kill a child, and capture status if not killed. by joelr

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (7)
    As of 2017-12-18 17:21 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      What programming language do you hate the most?




















      Results (494 votes). Check out past polls.

      Notices?