Perl closing pipe without error

2019-03-01 07:28发布

问题:

I'm using Perl to execute an external programme and would like to end its execution if it returns a specific string while running. The code below interrupts the execution as desired, however an error message is returned when the last line (close) is executed.

open (my $out, "-|", "usfos $memory<input-$cpu.scr");
while (<$out>) {
    if ($_ =~ /MIN   STEP  LENGTH/) {
        last;
    }
}
close $out;

This is the part of the error that is printed (the external programme also returns error messages):

...forrtl: The pipe is being closed.
forrtl: severe (38): error during write, unit 6, file CONOUT$

So I think it's because Perl is trying to write to a closed handle. How can I avoid anything being printed?

回答1:

You don't terminate the external program when you close $out, you close its STDOUT.

In order to close the program you need to get its process id and then send it a suitable signal. The open call returns the pid, just save it. Then send a signal when the condition is met.

use Scalar::Util qw(openhandle); # to check whether the handle is open

my $pid = open (my $out, "-|", "usfos $memory<input-$cpu.scr") 
                // die "Can't fork: $!";   # / stop editor red coloring
while (<$out>) {
    if (/MIN   STEP  LENGTH/) {
        kill "TERM", $pid;   # or whatever is appropriate; add checks
        close $out;          # no check: no process any more so returns false
        last;
    }
}
# Close it -- if it is still open. 
if (openhandle($out)) {          
    close $out or warn "Error closing pipe: $!";
}

See open and opentut, and close.

Fortran's error is indeed about writing to a non-existent console (STDOUT), so it seems to me that you diagnosed the problem correctly: as the condition is matched, you stop reading (last) and then close the program's STDOUT, which causes the reported error on its next attempted write.

A few notes. Closing of the pipe waits for the other process to finish. If the program on the other end has a problem that is going to be known at close, so $? may need be interrogated. Closing the pipe before the other program is done writing will send it SIGPIPE on its next write to that pipe. From close documentation

If the filehandle came from a piped open, close returns false if one of the other syscalls involved fails or if its program exits with non-zero status. If the only problem was that the program exited non-zero, $! will be set to 0 . Closing a pipe also waits for the process executing on the pipe to exit--in case you wish to look at the output of the pipe afterwards--and implicitly puts the exit status value of that command into $? and ${^CHILD_ERROR_NATIVE} .
...
Closing the read end of a pipe before the process writing to it at the other end is done writing results in the writer receiving a SIGPIPE. If the other end can't handle that, be sure to read all the data before closing the pipe.


Note added   The object is to kill a process while its STDOUT is connected to a filehandle and to close that filehandle (once a condition is met). If we first close the handle while the process may still write, we are sending a SIGPIPE to a process we may not know much about. (Does it handle the signal?) On the other hand, if we first terminate it the close($out) cannot complete with success, since the process that $out was connected to is gone.

This is why the code does not check the return from the call to close after the process is killed, as it is false (if kill succeeded). After the loop it checks whether the handle is still open before closing it, as we may or may have not closed it already. Package Scalar::Util is used for this, another option being fileno. Note that the code doesn't check whether kill did the job, add that as needed.


On a Windows system, it is a little different since you need to find the process ID of the child. You can do this using its name and then terminate it either using Win32::Process::Kill, or using kill. (Or, see a Windows command that should do all this, below.) To find the process ID try either of

  • Using Win32::Process::List

    use Win32::Process::Kill;
    use Win32::Process::List;
    my $pobj = Win32::Process::List->new(); 
    my %proc = $pobj->GetProcesses(); 
    my $exitcode;
    foreach my $pid (sort { $a <=> $b } keys %proc) {
        my $name = $proc{$pid};
        if ($name =~ /usfos\.exe/) {
            Win32::Process::KillProcess($pid, \$exitcode);
            # kill 21, $pid;
            last;
        }
     }
    
  • Using Win32::Process::Info. See this post.

    use Win32::Process::Info;
    Win32::Process::Info->Set(variant=>'WMI');   # SEE DOCS about WMI
    my $pobj = Win32::Process::Info->new();
    foreach my $pid ($pobj->ListPids) {
        my ($info) = $pobj->GetProcInfo($pid);
        if ($info->{CommandLine} =~ /^usfso/) {  # command-line, not name
            my $proc = $info->{ProcessId};
            kill 2, $proc; 
            last;
        }
    }
    

    Note that this module also provides the method Subprocesses([$ppid,...]), which will identify all children of the submitted $ppid(s). It returns a hash, which is indexed by $ppids and contains an array-ref with $pids of all subprocesses, for each $ppid submitted.

    use Win32::Process::Info;
    Win32::Process::Info->Set(variant=>'WMI');
    my $pobj = Win32::Process::Info->new();
    my %subproc = $pobj->Subprocesses([$pid]);   # pid returned by open() call
    my $rkids = $subproc{$pid};
    foreach my $kid (@$rkids) {
        print "pid: $kid\n";                     # I'd first check what is there
    }
    
  • I ran into a Windows command TASKKILL /T that should terminate a process and its children

    system("TASKKILL /F /T /PID $pid");
    

I cannot test any of this right now.



标签: perl pipe