How can I read the output from external commands i

问题:

I have a few bash scripts I run, but they can take several hours to finish, during which time they spew out download speeds, ETAs and similar information. I need to capture this information in perl, but I am running into a problem, I cannot read the output line by line(unless I'm missing something).

Any help working this out?

EDIT: to explain this a little better I'm running several bash scripts along side each other, I wish to use gtk with perl to produce handy progress bars. At present I'm running 2 threads for every bash script I wish to run, one master thread for updating the graphical information. It looks something like this(cut down as much as I possibly can):

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

回答1:

Instead of threads, and ``, use:

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

In this way open several filehandles (as many as many programs you need to run) and then use IO::Select to poll data from them.

Simplistic example.

Let's assume I have shell script that looks like this:

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

it's output might look like this:

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

Now, let's write a 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;
    }
}

As you can see there are no forks, no threads. And this is how it works:

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

回答2:

Backticks and the qx// operator both block until the sub-process finishes. You need to open the bash scripts on a pipe. If you need them to be non-blocking, open them as filehandles, using open2 or open3 if necessary, then put the handles into a select() and wait for them to become readable.

I just ran into a similar problem -- I had a very long-running process (a service that could run for weeks) that I opened with a qx//. The problem was that the output of this program eventually exceeded memory limits (around 2.5G on my architecture). I solved it by opening the sub-command on a pipe, then only saving the last 1000 lines of output. In doing so, I noticed that the qx// form only print the output once the command completed, but the pipe form was able to print output as it happened.

I don't have the code handy, but if you can wait until tomorrow, I'll post what I did.

回答3:

See the perlipc (interprocess communication) for several things you can do. Piped opens and IPC::Open3 are handy.

回答4:

yes, you can.

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

The problem is that some applications does not spew out info line by line but update one line till they're finished. Is it your case?

回答5:

Here it is with the GTK2 code for displaying the progress bars.

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

see the perl GTK2 docs for more info

回答6:

I use this sub routine and method to log my external commands. It's called like this:

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

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

close($logFileHandle);

and here are the sub-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; }
   }

回答7:

The simplest way to run a child process with full control over its input and output is the IPC::Open2 module (or IPC::Open3 if you want to capture STDERR as well), but the issue if you want to deal with multiple at once, or especially if you want to do it in a GUI, is blocking. If you just do a <$fh> type read it's going to block until you have input, potentially wedging your whole UI. If the child process is interactive it's even worse because you can easily deadlock, with both the child and the parent waiting for input from the other. You can write your own select loop and do nonblocking I/O, but it's not really worth it. My suggestion would be to use POE, POE::Wheel::Run to interface with the child processes, and POE::Loop::Gtk to subsume POE into the GTK runloop.