http://www.perlmonks.org?node_id=682903
joelr has asked for the wisdom of the Perl Monks concerning the following question:

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 ##############################################################