Perl закрывает трубу без ошибок

Question

Я использую Perl для выполнения внешней программы и хотел бы завершить ее выполнение, если она возвращает определенную строку во время работы. Приведенный ниже код прерывает выполнение по желанию, однако при выполнении последней строки (close) возвращается сообщение об ошибке.

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

Это часть ошибки, которая печатается (внешняя программа также возвращает сообщения об ошибках):

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

Так что я думаю, что это потому, что Perl пытается писать в закрытую ручку. Как я могу избежать печати чего-либо?

Answer 1

Вы не закрываете внешнюю программу, когда вы close $out закрываешь ее STDOUT,

Чтобы закрыть программу, вам нужно получить идентификатор процесса и затем отправить ему подходящий сигнал. open call возвращает pid, просто сохраните его. Затем отправьте сигнал, когда условие будет выполнено.

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: $!";
}

Увидеть open а также opentut, а также close,

Ошибка Фортрана действительно в записи на несуществующую консоль (STDOUT), так что мне кажется, что вы правильно поставили диагноз: по мере соответствия условия вы перестаете читать (last) и затем закройте программу STDOUT, который вызывает сообщенную ошибку при следующей попытке записи.

Несколько заметок. Закрытие трубы ожидает завершения другого процесса. Если у программы на другом конце есть проблема, о которой будет известно в close, так $? может потребоваться допрос. Закрытие канала перед завершением написания другой программы отправит его SIGPIPE в следующий раз напишите в эту трубу. От close документация

Если файловый дескриптор получен из открытого канала, close возвращает false, если один из других задействованных системных вызовов завершается неудачно или его программа завершает работу с ненулевым статусом. Если единственная проблема состояла в том, что программа вышла не из нуля, $! будет установлен в 0 . Закрытие канала также ожидает завершения процесса, выполняющегося на канале - в случае, если вы хотите посмотреть на вывод канала впоследствии - и неявно помещает значение состояния выхода этой команды в $? и $ {^ CHILD_ERROR_NATIVE}.
...
Закрытие конца чтения канала перед тем, как процесс записи в него на другом конце завершит запись результатов в писателе, получающем SIGPIPE. Если другой конец не может справиться с этим, обязательно прочитайте все данные перед закрытием канала.

---

Примечание добавлено Цель состоит в том, чтобы убить процесс, пока его STDOUT подключается к файловому дескриптору и закрывает этот файловый дескриптор (как только условие выполнено). Если мы сначала закроем дескриптор, пока процесс еще может писать, мы отправляем SIGPIPE к процессу, о котором мы можем не знать много. (Он обрабатывает сигнал?) С другой стороны, если мы сначала завершим его close($out) не может завершиться с успехом, так как процесс, который $out был связан с ушел.

Вот почему код не проверяет возврат от звонка close после того как процесс убит, так как он ложный (если kill удалось). После цикла он проверяет, открыт ли дескриптор, прежде чем закрывать его, как мы можем, а может и не закрыли. пакет Scalar::Util используется для этого, другой вариант fileno, Обратите внимание, что код не проверяет, kill сделал работу, добавьте это по мере необходимости.

---

В системе Windows это немного отличается, так как вам нужно найти идентификатор процесса дочернего процесса. Вы можете сделать это, используя его имя, а затем прекратить его либо используя Win32::Process::Kill или используя kill, (Или см. Команду Windows, которая должна сделать все это, ниже.) Чтобы найти идентификатор процесса, попробуйте любой из

• С помощью 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;
      }
   }
  

• С помощью Win32::Process::Info, Смотрите этот пост.

  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;
      }
  }
  

  Обратите внимание, что этот модуль также предоставляет метод Subprocesses([$ppid,...]), который идентифицирует всех детей представленных $ppid (Ы). Возвращает хеш, который индексируется $ppid s и содержит массив ref с $pid из всех подпроцессов, для каждого $ppid Отправлено.

  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
  }
  

• Я столкнулся с командой Windows TASKKILL /T что должно прекратить процесс и его дочерние элементы

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

Я не могу проверить это прямо сейчас.