Perl closing pipe without error

Question

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?

perl isnt trying to write, this is a pipe to read not write. it seems like your external programe is the one giving the error. — Chris Doyle, Apr 07 '16 at 08:33

zdim · Accepted Answer · 2022-08-19T06:48:55.327

That close $out doesn't terminate the external program but closes 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 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. A close on 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 interrogation. If a pipe is closed before the other program is done writing on its next write to that pipe the program will get a SIGPIPE. 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 a little catch here. The objective 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 may trigger 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 we need to find the process ID of the child. One can do this using its name and then terminate it either using Win32::Process::Kill, or kill. (Or, see a Windows command for 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;
    }
}

This module also provides the method Subprocesses([$ppid,...]), which identifies 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";                     # first check what is there
}

A Windows command TASKKILL /T should terminate a process and its children
```
system("TASKKILL /F /T /PID $pid");
```

I cannot test any of Windows code right now.

Perl closing pipe without error

1 Answers1

Linked