Как я могу завершить системную команду с тревогой в Perl?

Я использую приведенный ниже фрагмент кода в Windows. Сервер начинает слушать непрерывно после чтения с клиента. Я хочу прекратить эту команду после определенного периода времени.

Если я использую функцию будильника () в течение main.plзатем завершает всю программу Perl (здесь main.pl), поэтому я вызвал эту системную команду, поместив ее в отдельный файл Perl и вызвав этот файл Perl (alarm.pl) в исходном файле Perl с помощью системной команды.

Но таким образом я не смог принять вывод этого system() не вызывайте ни в исходном Perl-файле, ни в вызываемом Perl-файле.

Может кто-нибудь, пожалуйста, дайте мне знать, как прекратить system() позвонить или принять вывод таким образом, как я использовал выше?

main.pl

my @output = system("alarm.pl");
print"one iperf completed\n";

open FILE, ">display.txt" or die $!; 
print FILE @output_1; 
close FILE;

alarm.pl

alarm 30;
my @output_1 = readpipe("adb shell cd /data/app; ./iperf -u -s -p 5001");

open FILE, ">display.txt" or die $!; 
print FILE @output_1; 
close FILE;

В обе стороны display.txt всегда пусто

Источник

4 ответа

Здесь есть несколько отдельных вопросов.

Во-первых, чтобы сигнал тревоги не убивал ваш сценарий, вам нужно обработать сигнал ALRM. Смотрите документацию по сигнализации. Вам не нужно два сценария для этого.

Во-вторых, система не захватывает вывод. Вам нужен один из вариантов backtick или конвейер, если вы хотите это сделать. Ответы на это уже есть в Stackru.

В-третьих, если alarm.pl помещает что-либо в display.txt, вы отбрасываете его в main.pl при повторном открытии файла в режиме записи. Вам нужно всего лишь создать файл в одном месте. Когда вы избавитесь от лишнего скрипта, у вас не будет этой проблемы.

У меня недавно были некоторые проблемы с alarm а также system, но переход на IPC::System::Simple исправил это.

Удачи,:)

Источник

О чем, черт возьми, я думал? Вам не нужен фоновый процесс для этой задачи. Вам просто нужно следовать примеру в perldoc -f alarmфункционировать и обернуть свой чувствительный ко времени код вevalблок.

my $command = "adb shell cd /data/app; ./iperf -u -s -p 5001";
my @output;
eval {
    local $SIG{ALRM} = sub { die "Timeout\n" };
    alarm 30;
    @output = `$command`;
    alarm 0;
};
if ($@) {
    warn "$command timed out.\n";
} else {
    print "$command successful. Output was:\n", @output;
}

Внутриevalблок, вы можете захватить ваш вывод обычным способом (с помощью обратных галочек илиqx()или же readpipe). Хотя, если время ожидания истекло, никакого выхода не будет.

Если вам не нужен вывод (или вы не возражаете против взлома некоторого межпроцессного взаимодействия), почти защищенная от дурака альтернатива - установить будильник и запуститьsystemвызвать дочерний процесс.

$command = "adb shell cd /data/app; ./iperf -u -s -p 5001";
if (($pid = fork()) == 0) {
    # child process
    $SIG{ALRM} = sub { die "Timeout\n" }; # handling SIGALRM in child is optional
    alarm 30;
    my $c = system($command);
    alarm 0;
    exit $c >> 8;  # if you want to capture the exit status
}
# parent
waitpid $pid, 0;

waitpid вернется, когда либо ребенок systemКоманда завершена,или когда тревога ребенка гаснет и убивает ребенка. $?будет содержать код завершения системного вызова или что-то еще (142 в моей системе) для необработанного SIGALRM или 255, если ваш обработчик SIGALRM вызываетdie,

Источник

Я сталкиваюсь с подобной проблемой, которая требует:

  • запустить системную команду и получить ее вывод
  • время ожидания системной команды через x секунд
  • убить системный командный процесс и все дочерние процессы

После долгих чтений о Perl IPC и ручном fork & exec, я вышел с этим решением. Он реализован как имитация подпрограммы 'backtick'.

use Error qw(:try);

$SIG{ALRM} = sub {
    my $sig_name = shift;
    die "Timeout by signal [$sig_name]\n";
};

# example
my $command = "vmstat 1 1000000";
my $output = backtick( 
                 command => $command, 
                 timeout => 60, 
                 verbose => 0 
             );

sub backtick {

    my %arg = (
        command => undef,
        timeout => 900,
        verbose => 1,
        @_,
    );

    my @output;

    defined( my $pid = open( KID, "-|" ) )
        or die "Can't fork: $!\n";

    if ($pid) {

        # parent

        # print "parent: child pid [$pid]\n" if $arg{verbose};

        try {
            alarm( $arg{timeout} );
            while (<KID>) {
                chomp;
                push @output, $_;
            }

            alarm(0);
        }
        catch Error with {
            my $err = shift;
            print $err->{-text} . "\n";

            print "Killing child process [$pid] ...\n" if $arg{verbose};
            kill -9, $pid;
            print "Killed\n" if $arg{verbose};

            alarm(0);
        }
        finally {};
    }
    else {

        # child

        # set the child process to be a group leader, so that
        # kill -9 will kill it and all its descendents
        setpgrp( 0, 0 );

        # print "child: pid [$pid]\n" if $arg{verbose};
        exec $arg{command};
        exit;
    }

    wantarray ? @output : join( "\n", @output );
}
Источник

Можно использовать "timeout -n " для переноса ваших команд, если это уже распространено в вашей системе.

Источник
Другие вопросы по тегам