Perl: как запретить SIGALRM закрывать канал?

Мой канал (дескриптор файла, сокет) ломается (иногда). Я могу воспроизвести его с помощью следующего кода:

my $counter = 5;
alarm(1);

open(FH,"while(sleep 2); do date; done |") or die $!;
while (<FH>) { print; }
close(FH);

BEGIN {
    $SIG{ALRM} = sub { 
        print "alarm!\n"; 
        exit if --$counter == 0;
        alarm(1);
    };
}

Что будет производить:

alarm!
alarm!
Thu Feb  7 11:46:29 EST 2013
alarm!
alarm!
alarm!

Если я отследю этот процесс, я увижу, что созданная оболочка получает SIGPIPE. Однако процесс Perl благополучно продолжается. Как это исправить?


person Willem    schedule 07.02.2013    source источник
comment
В чем проблема? В вашем обработчике ALRM вы вызываете exit, поэтому perl завершает работу и закрывает файловый дескриптор. Когда подоболочка записывает в дескриптор закрытого файла, она получает SIGPIPE. Вы хотите, чтобы подоболочка игнорировала SIGPIPE и просто продолжала работать вечно с ошибками записи?   -  person William Pursell    schedule 07.02.2013
comment
Ваш Perl-процесс успешно продолжается после вызова exit ??   -  person mob    schedule 07.02.2013


Ответы (1)


Проблема в том, что <FH> возвращает false из-за прерванного системного вызова. Я не уверен, что это идиоматический способ справиться с этим в Perl (и хотелось бы увидеть лучший ответ), но, похоже, работает следующее:

my $counter = 5;
alarm 1;

open my $fh, '-|', 'while(sleep 2); do date; done' or die $!;
loop:
while (<$fh>) { print; }
goto loop if $!{EINTR};
close $fh;

BEGIN {
    $SIG{ALRM} = sub { 
        print "alarm!\n"; 
        alarm 1;
        exit if --$counter <= 0;
    };
}
person William Pursell    schedule 07.02.2013
comment
Я не знаю ни идиоматики, ни того, но это то, что я обычно делал. - person darch; 14.02.2013