Wie kann ich die Ausgabe von externen Befehlen in Echtzeit in Perl lesen?

Question

Ich habe ein paar Bash-Skripts, die ich laufe, aber sie können mehrere Stunden dauern, bis sie fertig sind, während der sie Download-Geschwindigkeiten, ETAs und ähnliche Informationen ausspucken. Ich muss diese Informationen in Perl erfassen, aber ich stoße auf ein Problem, ich kann die Ausgabe Zeile für Zeile nicht lesen (es sei denn, ich verpasse etwas).

Haben Sie Hilfe dabei?

EDIT: um dies ein wenig besser zu erklären Ich bin mehrere Bash-Skripte nebeneinander laufen, möchte ich gtk mit Perl verwenden, um handliche Fortschrittsbalken zu erzeugen. Momentan laufe ich zwei Threads für jedes Bash-Skript, das ich ausführen möchte, einen Master-Thread für die Aktualisierung der grafischen Informationen. Es sieht in etwa so aus (so weit wie möglich):

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

Statt Threads und ``, zu verwenden:

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

Auf diese Weise öffnen mehrere Handles (so viele wie viele Programme, die Sie ausführen müssen) und dann IO::Select verwenden, um Daten von ihnen abzufragen.

Simplistisches Beispiel.

Nehmen wir an, ich Shell-Skript, das wie folgt aussieht:

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

es Ausgabe wie folgt aussehen könnte:

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

Nun lassen Sie uns bitte 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; 
    } 
} 

Wie Sie sehen können, gibt es keine Gabeln, keine Fäden. Und so funktioniert es:

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

ja, du kannst.

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

Das Problem ist, dass einige Anwendungen nicht für Zeile Info-Zeile nicht spucken, aber eine Zeile aktualisieren, bis sie fertig sind. Ist es dein Fall?

Answer 3

Backticks und der Operator qx // blockieren beide, bis der Unterprozess beendet ist. Sie müssen die Bash-Skripte in einer Pipe öffnen. Wenn sie nicht blockierend sein sollen, öffne sie als Dateihandles, benutze ggf. open2 oder open3, setze dann die Handles in select() und warte, bis sie lesbar werden.

Ich stieß gerade auf ein ähnliches Problem - ich hatte einen sehr lang laufenden Prozess (ein Service, der wochenlang laufen konnte), den ich mit einem qx // öffnete. Das Problem war, dass die Ausgabe dieses Programms schließlich Speichergrenzen (um 2,5G auf meiner Architektur) überschritten. Ich habe es gelöst, indem ich den Unterbefehl für eine Pipe geöffnet habe und dann nur die letzten 1000 Zeilen der Ausgabe gespeichert habe. Dabei habe ich festgestellt, dass die qx // Form die Ausgabe nur dann druckt, wenn der Befehl abgeschlossen ist, aber das Rohrformular konnte die Ausgabe so ausgeben, wie es passierte.

Ich habe den Code nicht griffbereit, aber wenn Sie bis morgen warten können, werde ich posten, was ich tat.

Answer 4

Hier ist es mit dem GTK2-Code für die Anzeige der Fortschrittsbalken.

#!/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/; 
      } 
     } 
    } 

siehe the perl GTK2 docs für weitere Informationen

Answer 5

Ich benutze diese Unterroutine und Methode meine externen Befehle zu protokollieren. Es wird wie folgt aufgerufen:

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

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

close($logFileHandle); 

und hier die Subroutinen sind:

#****************************************************************************** 
# 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

Siehe perlipc (Interprozesskommunikation) für mehrere Dinge, die Sie tun können. Piped öffnet und IPC :: Open3 sind praktisch.

Answer 7

Der einfachste Weg, ein Kind Prozess mit voller Kontrolle über seinen Eingang und Ausgang ist das IPC::Open2 Modul (oder IPC::Open3 wenn Sie STDERR auch wollen erfassen) zu laufen, aber das Problem Wenn Sie mit mehreren gleichzeitig arbeiten möchten, oder vor allem, wenn Sie dies in einer GUI tun möchten, blockiert dies. Wenn Sie nur einen <$fh> Typ lesen, wird es blockieren, bis Sie eine Eingabe haben, die möglicherweise Ihre gesamte Benutzeroberfläche verkeilt. Wenn der Kindprozess interaktiv ist, ist es sogar noch schlimmer, da Sie leicht einen Deadlock vornehmen können, während sowohl das Kind als auch das Elternteil auf die Eingabe des anderen warten. Sie können Ihre eigene select-Schleife schreiben und nicht blockierende E/A ausführen, aber es lohnt sich nicht wirklich. Mein Vorschlag wäre, POE, POE::Wheel::Run als Schnittstelle zu den untergeordneten Prozessen und POE::Loop::Gtk zu verwenden, um POE in den GTK-Runloop zu subsumieren.