如何在Perl中实时读取外部命令的输出？

Question

我有几个bash脚本运行，但是他们可能需要几个小时才能完成，在这段时间，他们会发出下载速度，ETA和类似的信息。我需要在perl中捕获这些信息，但是我遇到了一个问题，我无法逐行读取输出行（除非我错过了某些内容）。

任何帮助解决这个问题？

编辑：解释这个更好一点我运行几个bash脚本沿彼此，我希望使用gtk与Perl产生方便的进度条。 目前，我为每个希望运行的bash脚本运行2个线程，一个用于更新图形信息的主线程。它看起来像这样（尽可能多地减少）：

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

Answer 1

而是线程，和``，使用：

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

这样打开几个文件句柄（多达许多程序需要运行），然后使用IO::Select向他们查询数据。

简单的例子。

假设我有shell脚本，看起来像这样：

=> 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 

Answer 2

是的，你可以。

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

问题是，有些应用程序不会逐行输出信息，而是更新一行直到它们完成。是你的情况吗？

Answer 3

反向引用和qx //运算符都会阻塞，直到子进程结束。您需要在管道上打开bash脚本。如果你需要它们是非阻塞的，打开它们作为文件句柄，必要时使用open2或open3，然后把句柄放入select（）并等待它们变得可读。

我刚碰到类似的问题 - 我有一个运行时间很长的过程（一个可以运行数周的服务），我用qx打开//。问题在于这个程序的输出最终超出了内存限制（在我的架构上大约为2.5G）。我通过在管道上打开子命令来解决它，然后只保存最后1000行输出。在这样做的时候，我注意到qx //表单只在命令完成后才打印输出，但是管道表单能够在发生输出时打印输出。

我没有代码方便，但如果你可以等到明天，我会发布我做的。

Answer 4

这里是用于显示进度条的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/; 
      } 
     } 
    } 

看到the perl GTK2 docs更多信息

Answer 5

我用这个子程序和方法登录我的外部命令。这就是所谓的像这样：

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

Answer 6

见perlipc（进程间通信）的几件事情可以做。管道打开并且IPC :: Open3非常方便。

Answer 7

与在其输入和输出完全控制运行一个子进程的最简单方法是IPC::Open2模块（或IPC::Open3，如果你想捕捉STDERR为好），但问题如果你想一次处理多个数据，或者特别是如果你想在GUI中处理数据，就会被阻塞。如果你只是做一个<$fh>类型的阅读，它会阻止，直到你有输入，可能会楔住你的整个用户界面。如果子进程是交互式的，那么它会更糟糕，因为您可能很容易死锁，同时子进程和父进程等待另一个进程的输入。您可以编写自己的select循环并执行非阻塞I/O，但这并不值得。我的建议是使用POE,POE::Wheel::Run与子进程对接，并使用POE::Loop::Gtk将POE包含到GTK runloop中。