Вопрос по bash, stdin, perl – Как я могу прочитать вывод из внешних команд в режиме реального времени в Perl?

5

У меня есть несколько скриптов bash, которые я запускаю, но они могут занять несколько часов, в течение которых они извергают скорость загрузки, ETA и подобную информацию. Мне нужно захватить эту информацию в perl, но я столкнулся с проблемой, я не могу прочитать вывод построчно (если я что-то упустил).

Любая помощь, решающая это?

РЕДАКТИРОВАТЬ: чтобы объяснить это немного лучше, я запускаю несколько сценариев bash рядом друг с другом, я хочу использовать gtk с perl для создания удобных индикаторов выполнения. В настоящее время я запускаю 2 потока для каждого сценария bash, который я хочу запустить, один основной поток для обновления графической информации. Это выглядит примерно так (сократить столько, сколько я могу):

  my $command1 = threads->create(\&runCmd, './bash1', \@out1);
  my $controll1 = threads->create(\&monitor, $command1, \@out1);
  my $command1 = threads->create(\&runCmd, 'bash2', \@out2);
  my $controll2 = threads->create(\&monitor, $command2, \@out2);

  sub runCmd{
     my $cmd = shift;
     my @bso = shift;
     @bso = `$cmd`
  }
  sub monitor{
     my $thrd = shift;
     my @bso = shift;
     my $line;
     while($thrd->is_running()){
       while($line = shift(@bso)){
         ## I check the line and do things with it here
       }
       ## update anything the script doesn't tell me here.
       sleep 1;# don't cripple the system polling data.
     }
     ## thread quit, so we remove the status bar and check if another script is in the queue, I'm omitting this here.
  }
Вы действительно должны использовать правильный цикл событий, такой как POE, вместо потоков. Вы будете иметь гораздо больший успех с POE :: Wheel :: Run, чем ваш собственный свернутый вручную цикл обработки событий. (Я бы порекомендовал AnyEvent :: Subprocess, но он подвергается серьезному рефакторингу и сразу не решит вашу проблему.) jrockway

Ваш Ответ

7   ответов
8

 open my $fh, '-|', 'some_program --with-options';

Таким образом, откройте несколько файловых дескрипторов (столько программ, сколько вам нужно запустить), а затем используйтеIO::Select опросить данные из них.

Упрощенный пример.

Предположим, у меня есть сценарий оболочки, который выглядит следующим образом:

=> cat test.sh
#!/bin/bash
for i in $( seq 1 5 )
do
    sleep 1
    echo "from $$ : $( date )"
done

это может выглядеть так:

=> ./test.sh
from 26513 : Fri Aug  7 08:48:06 CEST 2009
from 26513 : Fri Aug  7 08:48:07 CEST 2009
from 26513 : Fri Aug  7 08:48:08 CEST 2009
from 26513 : Fri Aug  7 08:48:09 CEST 2009
from 26513 : Fri Aug  7 08:48:10 CEST 2009

Теперь давайте напишемmulti-test.pl:

#!/usr/bin/perl -w
use strict;
use IO::Select;

my $s = IO::Select->new();

for (1..2) {
    open my $fh, '-|', './test.sh';
    $s->add($fh);
}

while (my @readers = $s->can_read()) {
    for my $fh (@readers) {
        if (eof $fh) {
            $s->remove($fh);
            next;
        }
        my $l = <$fh>;
        print $l;
    }
}

Как видите, нет ни вилок, ни ниток. И вот как это работает:

=> time ./multi-test.pl
from 28596 : Fri Aug  7 09:05:54 CEST 2009
from 28599 : Fri Aug  7 09:05:54 CEST 2009
from 28596 : Fri Aug  7 09:05:55 CEST 2009
from 28599 : Fri Aug  7 09:05:55 CEST 2009
from 28596 : Fri Aug  7 09:05:56 CEST 2009
from 28599 : Fri Aug  7 09:05:56 CEST 2009
from 28596 : Fri Aug  7 09:05:57 CEST 2009
from 28599 : Fri Aug  7 09:05:57 CEST 2009
from 28596 : Fri Aug  7 09:05:58 CEST 2009
from 28599 : Fri Aug  7 09:05:58 CEST 2009

real    0m5.128s
user    0m0.060s
sys     0m0.076s
На данный момент это выглядит самым чистым решением, большое спасибо. Не должно быть слишком много работы, чтобы мой текущий (хакерский и не совсем работающий) код работал идеально, как вы и предоставили. Еще раз спасибо. scragar
1

анд. Это называется так:

open($logFileHandle, "mylogfile.log");

logProcess($logFileHandle, "ls -lsaF", 1, 0); #any system command works

close($logFileHandle);

и вот подпрограммы:

#******************************************************************************
# Sub-routine: logProcess()
#      Author: Ron Savage
#        Date: 10/31/2006
# 
# Description:
# This sub-routine runs the command sent to it and writes all the output from
# the process to the log.
#******************************************************************************
sub logProcess
   {
   my $results;

   my ( $logFileHandle, $cmd, $print_flag, $no_time_flag ) = @_;
   my $logMsg;
   my $debug = 0;

   if ( $debug ) { logMsg($logFileHandle,"Opening command: [$cmd]", $print_flag, $no_time_flag); }
   if ( open( $results, "$cmd |") )
      {
      while (<$results>)
         {
         chomp;
         if ( $debug ) { logMsg($logFileHandle,"Reading from command: [$_]", $print_flag, $no_time_flag); }
         logMsg($logFileHandle, $_, $print_flag, $no_time_flag);
         }

      if ( $debug ) { logMsg($logFileHandle,"closing command.", $print_flag, $no_time_flag); }
      close($results);
      }
   else
      {
      logMsg($logFileHandle, "Couldn't open command: [$cmd].")
      }
   }

#******************************************************************************
# Sub-routine: logMsg()
#      Author: Ron Savage
#        Date: 10/31/2006
# 
# Description:
# This sub-routine prints the msg and logs it to the log file during the 
# install process.
#******************************************************************************
sub logMsg
   {
   my ( $logFileHandle, $msg, $print_flag, $time_flag ) = @_;
   if ( !defined($print_flag) ) { $print_flag = 1; }
   if ( !defined($time_flag) ) { $time_flag = 1; }

   my $logMsg;

   if ( $time_flag ) 
      { $logMsg = "[" . timeStamp() . "] $msg\n"; }
   else 
      { $logMsg = "$msg\n"; } 

   if ( defined($logFileHandle)) { print $logFileHandle $logMsg; }

   if ( $print_flag ) { print $logMsg; }
   }
2

perlipc (межпроцессное взаимодействие) для нескольких вещей, которые вы можете сделать. Piped открывает и IPC :: Open3 удобны.

3

а. Вам нужно открыть bash-скрипты на конвейере. Если вам нужно, чтобы они были неблокирующими, откройте их как файловые дескрипторы, используя при необходимости open2 или open3, затем поместите дескрипторы в select () и подождите, пока они станут читаемыми.

Я просто столкнулся с подобной проблемой - у меня был очень длительный процесс (сервис, который мог работать неделями), который я открыл с помощью qx //. Проблема заключалась в том, что выход этой программы в конечном итоге превысил пределы памяти (около 2,5 ГБ в моей архитектуре). Я решил это, открыв подкоманду на конвейере, сохранив только 1000 последних строк. При этом я заметил, что форма qx // печатает выходные данные только после завершения команды, но форма канала могла печатать выходные данные, как это произошло.

У меня нет удобного кода, но если вы можете подождать до завтра, я опубликую то, что сделал.

0

ввода и вывода - этоIPC::Open2 модуль (илиIPC::Open3 если вы также хотите захватить STDERR), но проблема, если вы хотите иметь дело с несколькими одновременно, или, особенно, если вы хотите сделать это в графическом интерфейсе, - это блокировка. Если вы просто делаете<$fh> введите read, он будет блокироваться до тех пор, пока у вас не будет ввода, потенциально заклинивая весь ваш пользовательский интерфейс. Если дочерний процесс является интерактивным, это еще хуже, потому что вы можете легко зайти в тупик, когда и дочерний процесс, и родитель ожидают ввода от другого. Вы можете написать свой собственныйselect зацикливайте и выполняйте неблокирующий ввод / вывод, но это не стоит того. Мое предложение будет использоватьPOE, POE::Wheel::Run взаимодействовать с дочерними процессами иPOE::Loop::Gtk включить POE в цикл выполнения GTK.

1

#!/usr/bin/perl
use strict;
use warnings;

use Glib qw/TRUE FALSE/;
use Gtk2 '-init';

my $window = Gtk2::Window->new('toplevel');
$window->set_resizable(TRUE);
$window->set_title("command runner");

my $vbox = Gtk2::VBox->new(FALSE, 5);
$vbox->set_border_width(10);
$window->add($vbox);
$vbox->show;

# Create a centering alignment object;
my $align = Gtk2::Alignment->new(0.5, 0.5, 0, 0);
$vbox->pack_start($align, FALSE, FALSE, 5);
$align->show;

# Create the Gtk2::ProgressBar and attach it to the window reference.
my $pbar = Gtk2::ProgressBar->new;
$window->{pbar} = $pbar;
$align->add($pbar);
$pbar->show;

# Add a button to exit the program.
my $runbutton = Gtk2::Button->new("Run");
$runbutton->signal_connect_swapped(clicked => \&runCommands, $window);
$vbox->pack_start($runbutton, FALSE, FALSE, 0);

# This makes it so the button is the default.
$runbutton->can_default(TRUE);

# This grabs this button to be the default button. Simply hitting the "Enter"
# key will cause this button to activate.
$runbutton->grab_default;
$runbutton->show;

# Add a button to exit the program.
my $closebutton = Gtk2::Button->new("Close");
$closebutton->signal_connect_swapped(clicked => sub { $_[0]->destroy;Gtk2->main_quit; }, $window);
$vbox->pack_start($closebutton, FALSE, FALSE, 0);

$closebutton->show;

$window->show;

Gtk2->main;

sub pbar_increment {
    my ($pbar, $amount) = @_;

    # Calculate the value of the progress bar using the
    # value range set in the adjustment object
    my $new_val = $pbar->get_fraction() + $amount;

    $new_val = 0.0 if $new_val > 1.0;

    # Set the new value
    $pbar->set_fra,ction($new_val);
}

sub runCommands {
        use IO::Select;

        my $s = IO::Select->new();

        for (1..2) {
            open my $fh, '-|', './test.sh';
            $s->add($fh);
        }

        while (my @readers = $s->can_read()) {
            for my $fh (@readers) {
                if (eof $fh) {
                    $s->remove($fh);
                    next;
                }
                my $l = <$fh>;
                print $l;
                pbar_increment($pbar, .25) if $l =~ /output/;
            }
        }
    }

увидетьPerl GTK2 документы для получения дополнительной информации

Живи и учись ... одна из лучших вещей в SO - это то, что я здесь не самый умный человек.
Ой. Мои. Это определение избыточного убийства.
1

Да, ты можешь.

while (<STDIN>) { print "Line: $_"; }

Проблема состоит в том, что некоторые приложения не выводят информацию построчно, а обновляют одну строку, пока они не будут завершены. Это твой случай?

Строки не поступают из стандарта in, но я могу открыть строку для скрипта с помощью команды open, чтобы она работала. Моя проблема в том, что когда не вводится никаких данных, я хочу иметь возможность делать что-то иное, чем ждать ввода строки (что и делает этот цикл). В настоящий момент я выполняю очень запутанную комбинацию потоков, чтобы достичь этого (я обновлю вопрос, чтобы показать это). scragar
Если вы не запускаете скрипт в Windows, вы можете использовать команду select, чтобы проверить, есть ли какие-либо данные в дескрипторе файла. Примерно что-то вроде этого: while (1) {my $ rin = & apos; ';; vec ($ rin, fileno (STDIN), 1) = 1; my ($ nfound, $ timeleft) = select ($ rin, undef, undef, 0); if ($ nfound) {мои $ данные; распечатать & quot; Получил данные! \ n & quot ;; sysread STDIN, $ data, 1024; напечатать "DATA: $ data \ n"; } else {print & quot; wait ... \ n & quot ;; сон (1); }}

Похожие вопросы