Comment puis-je lire le résultat de commandes externes en temps réel en Perl ?
https://stackoverflow.com/questions/1236089
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianQuestion
J'ai quelques scripts bash que j'exécute, mais leur exécution peut prendre plusieurs heures, pendant lesquelles ils diffusent des vitesses de téléchargement, des ETA et des informations similaires.J'ai besoin de capturer ces informations en Perl, mais je rencontre un problème, je ne peux pas lire la sortie ligne par ligne (sauf si quelque chose me manque).
Avez-vous de l'aide pour résoudre ce problème ?
MODIFIER:pour expliquer cela un peu mieux, j'exécute plusieurs scripts bash les uns à côté des autres, je souhaite utiliser gtk avec Perl pour produire des barres de progression pratiques.À l'heure actuelle, j'exécute 2 threads pour chaque script bash que je souhaite exécuter, un thread principal pour mettre à jour les informations graphiques.Cela ressemble à ceci (réduisez autant que possible) :
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.
}
La solution
Au lieu de threads et de ``, utilisez:
open my $fh, '-|', 'some_program --with-options';
Ouvrez ainsi plusieurs descripteurs de fichiers (autant de programmes que vous devez exécuter), puis utilisez IO::Select pour interroger leurs données.
Exemple simpliste.
Supposons que j'ai un script shell qui ressemble à ceci:
=> cat test.sh
#!/bin/bash
for i in $( seq 1 5 )
do
sleep 1
echo "from $$ : $( date )"
done
sa sortie pourrait ressembler à ceci:
=> ./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
Maintenant, écrivons 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;
}
}
Comme vous pouvez le constater, il n'y a pas de fourches, pas de threads. Et voici comment cela fonctionne:
=> 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
Autres conseils
Les backticks et l'opérateur qx // bloquent tous deux jusqu'à la fin du sous-processus.Vous devez ouvrir les scripts bash sur un tube.Si vous avez besoin qu'ils ne soient pas bloquants, ouvrez-les en tant que descripteurs de fichiers, en utilisant open2 ou open3 si nécessaire, puis placez les descripteurs dans un select() et attendez qu'ils deviennent lisibles.
Je viens de rencontrer un problème similaire : j'avais un processus de très longue durée (un service qui pouvait durer des semaines) que j'ai ouvert avec un qx//.Le problème était que la sortie de ce programme dépassait finalement les limites de mémoire (environ 2,5 Go sur mon architecture).Je l'ai résolu en ouvrant la sous-commande sur un tube, puis en enregistrant uniquement les 1000 dernières lignes de sortie.Ce faisant, j'ai remarqué que le formulaire qx// n'imprimait la sortie qu'une fois la commande terminée, mais que le formulaire pipe était capable d'imprimer la sortie au fur et à mesure.
Je n'ai pas le code sous la main, mais si vous pouvez attendre jusqu'à demain, je publierai ce que j'ai fait.
Reportez-vous à la perlipc (communication entre processus) pour connaître plusieurs choses à faire. Piped opens et IPC :: Open3 sont pratiques.
oui, vous le pouvez.
while (<STDIN>) { print "Line: $_"; }
Le problème est que certaines applications ne crachent pas d’informations ligne par ligne mais mettent à jour une ligne jusqu’à ce qu’elles soient terminées. Est-ce votre cas?
Le voici avec le code GTK2 pour afficher les barres de progression.
#!/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/;
}
}
}
voir les documents Perl GTK2 docs pour plus d'informations
J'utilise cette sous-routine et cette méthode pour consigner mes commandes externes. Ça s'appelle comme ça:
open($logFileHandle, "mylogfile.log");
logProcess($logFileHandle, "ls -lsaF", 1, 0); #any system command works
close($logFileHandle);
et voici les sous-routines:
#******************************************************************************
# 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; }
}
Le moyen le plus simple d’exécuter un processus enfant avec un contrôle total sur son entrée et sa sortie est le module IPC :: Open2 (ou IPC :: Open3 si vous le souhaitez. capturez STDERR également), mais le problème est le blocage si vous souhaitez traiter plusieurs éléments à la fois, ou surtout si vous souhaitez le faire dans une interface graphique. Si vous vous contentez de lire un type < $ fh > , il sera bloqué tant que vous n’aurez pas saisi d’entrée, bloquant ainsi l’ensemble de votre interface utilisateur. Si le processus enfant est interactif, c'est encore pire, car vous pouvez facilement créer une impasse, l'enfant et le parent attendant à la fois l'entrée de l'autre. Vous pouvez écrire votre propre boucle select et faire des E / S non bloquantes, mais cela ne vaut vraiment pas la peine. Ma suggestion serait d'utiliser POE , POE :: Wheel :: Run pour assurer l'interface avec les processus enfants et POE :: Loop :: Gtk subsumer POE dans la boucle d’analyse GTK.
