Come posso leggere l'output di comandi esterni in tempo reale in Perl?
https://stackoverflow.com/questions/1236089
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianDomanda
Ho alcuni script bash che eseguo, ma possono richiedere diverse ore per essere completati, durante le quali emettono velocità di download, ETA e informazioni simili.Devo acquisire queste informazioni in Perl, ma sto riscontrando un problema, non riesco a leggere l'output riga per riga (a meno che non mi manchi qualcosa).
Qualche aiuto per risolvere il problema?
MODIFICARE:per spiegarlo un po' meglio sto eseguendo diversi script bash uno accanto all'altro, desidero usare gtk con perl per produrre comode barre di avanzamento.Al momento sto eseguendo 2 thread per ogni script bash che desidero eseguire, un thread principale per l'aggiornamento delle informazioni grafiche.Assomiglia a questo (riduci il più possibile):
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.
}
Soluzione
Invece di thread e '', usa:
open my $fh, '-|', 'some_program --with-options';
In questo modo apri diversi filehandle (tanti quanti programmi devi eseguire) e poi usa IO::Select per eseguire il polling dei dati da essi.
Esempio semplicistico.
Supponiamo che io abbia uno script di shell simile al seguente:
=> cat test.sh
#!/bin/bash
for i in $( seq 1 5 )
do
sleep 1
echo "from $$ : $( date )"
done
il suo output potrebbe apparire così:
=> ./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
Ora scriviamo un 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;
}
}
Come puoi vedere non ci sono forchette, né thread. Ed è così che funziona:
=> 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
Altri suggerimenti
I backtick e l'operatore qx// si bloccano entrambi finché il sottoprocesso non termina.È necessario aprire gli script bash su una pipe.Se hai bisogno che non siano bloccanti, aprili come filehandle, usando open2 o open3 se necessario, quindi inserisci gli handle in una select() e attendi che diventino leggibili.
Ho appena riscontrato un problema simile: avevo un processo molto lungo (un servizio che poteva funzionare per settimane) che ho aperto con un qx//.Il problema era che l'output di questo programma alla fine superava i limiti di memoria (circa 2,5G sulla mia architettura).L'ho risolto aprendo il sottocomando su una pipe, quindi salvando solo le ultime 1000 righe di output.In tal modo, ho notato che il modulo qx// stampa l'output solo una volta completato il comando, ma il modulo pipe è stato in grado di stampare l'output mentre accadeva.
Non ho il codice a portata di mano, ma se puoi aspettare fino a domani, pubblicherò quello che ho fatto.
Vedi perlipc (comunicazione tra processi) per diverse cose che puoi fare. Piped opens e IPC :: Open3 sono utili.
sì, puoi.
while (<STDIN>) { print "Line: $_"; }
Il problema è che alcune applicazioni non emettono informazioni riga per riga ma aggiornano una riga fino al termine. È il tuo caso?
Eccolo qui con il codice GTK2 per visualizzare le barre di avanzamento.
#!/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/;
}
}
}
vedi i documenti perl GTK2 per maggiori informazioni
Uso questa sub routine e metodo per registrare i miei comandi esterni. Si chiama così:
open($logFileHandle, "mylogfile.log");
logProcess($logFileHandle, "ls -lsaF", 1, 0); #any system command works
close($logFileHandle);
e qui ci sono le sub-routine:
#******************************************************************************
# 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; }
}
Il modo più semplice per eseguire un processo figlio con il pieno controllo su input e output è il modulo IPC::Open2 (o IPC::Open3 se si desidera acquisire anche STDERR), ma il problema se si desidera gestire più subito, o soprattutto se si desidera farlo in una GUI, si sta bloccando. Se fai solo una lettura di tipo <$fh>, si bloccherà fino a quando non avrai inserito, potenzialmente wedging l'intera UI. Se il processo figlio è interattivo, è anche peggio perché puoi facilmente eseguire il deadlock, con il bambino e il genitore in attesa di input dall'altro. Puoi scrivere il tuo ciclo select ed eseguire I / O senza blocco, ma non ne vale davvero la pena. Il mio suggerimento sarebbe di usare POE, POE::Wheel::Run per interfacciarsi con i processi figlio e POE::Loop::Gtk per iscrivere POE nel runloop GTK.
