Как я могу прочитать вывод из внешних команд в режиме реального времени в Perl? - PullRequest
Новая
       24

Как я могу прочитать вывод из внешних команд в режиме реального времени в Perl?

5 голосов
/ 06 августа 2009

У меня есть несколько скриптов 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.
  }

Ответы [ 7 ]

8 голосов
/ 07 августа 2009

Вместо потоков и `` используйте: 

 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
3 голосов
/ 06 августа 2009

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

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

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

2 голосов
/ 07 августа 2009

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

1 голос
/ 06 августа 2009

Я использую эту подпрограмму и метод для регистрации своих внешних команд. Это называется так: 

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; }
   }
1 голос
/ 06 августа 2009

Вот с кодом GTK2 для отображения индикаторов выполнения. 

#!/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_fraction($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 для получения дополнительной информации

1 голос
/ 06 августа 2009

да, вы можете. 

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

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

0 голосов
/ 08 августа 2009

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

...