كيف يمكنني قراءة الإخراج من الأوامر الخارجية في الوقت الحقيقي في بيرل؟

StackOverflow https://stackoverflow.com/questions/1236089

  •  22-07-2019
  •  | 
  •  

سؤال

ولدي بعض النصوص باش أركض، ولكنها يمكن أن يستغرق عدة ساعات وحتى النهاية، وهي الفترة التي يقذف بها سرعات تحميل الملفات، الوقت المقدر للوصول ومعلومات مشابهة. ولست بحاجة لالتقاط هذه المعلومات في بيرل، ولكن أنا على التوالي في مشكلة، وأنا لا يمكن قراءة خط الانتاج خط (إلا إذا أنا شيء مفقود).

وأي مساعدة تعمل هذا؟

وتحرير: لشرح هذا أفضل قليلا أنا على التوالي عدة مخطوطات باش جنبا الى جنب مع بعضها البعض، وأود أن استخدام جتك مع بيرل لإنتاج أشرطة التقدم في متناول يدي. في الوقت الحاضر أنا على التوالي 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.
  }
هل كانت مفيدة؟

المحلول

وبدلا من المواضيع، و``، الاستخدام:

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

في هذه الطريقة عدة filehandles المفتوحة (ما يصل إلى العديد من البرامج تحتاج إلى تشغيل) ثم استخدام <لأ href = "http://search.cpan.org/perldoc؟IO::Select" يختلط = "noreferrer" > IO::Select لالاستقصاء البيانات منها.

والمثال التبسيط.

لنفترض لدي شيل الذي يبدو مثل هذا:

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

نصائح أخرى

وBackticks وQX // مشغل كلا كتلة حتى انتهاء عملية الفرعية. تحتاج إلى فتح البرامج النصية باش على الأنابيب. إذا كنت في حاجة إليها لتكون غير مؤمن، وفتح لهم كما filehandles، وذلك باستخدام open2 أو open3 إذا لزم الأمر، ثم وضع مقابض في تحديد () وننتظر منهم أن تصبح قابلة للقراءة.

وركضت فقط في مشكلة مماثلة - كان لي عملية مستمرة منذ فترة طويلة جدا (الخدمة التي يمكن أن تعمل لمدة أسابيع) التي فتحت مع QX //. والمشكلة هي أن إخراج هذا البرنامج تجاوزت في نهاية المطاف حدود الذاكرة (حوالي 2.5G في العمارة بلدي). I حلها من خلال فتح الأمر من الباطن على الأنابيب، ثم حفظ فقط خطوط 1000 مشاركة من الانتاج. في القيام بذلك، لاحظت أن QX // النموذج طباعة فقط خرج مرة واحدة إكمال الأمر، ولكن كان على شكل أنبوب قادرة على طباعة الانتاج كما حدث.

وأنا لم يكن لديك رمز مفيد، ولكن إذا كنت تستطيع الانتظار حتى يوم غد، أنا ما بعد ما فعلته.

perlipc (اتصال interprocess) لعدة أشياء يمكنك القيام به. بالأنابيب يفتح وIPC :: Open3 هي في متناول يدي.

نعم، يمكنك.

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

والمشكلة هي أن بعض التطبيقات لا يقذف خارج خط المعلومات حسب الماركة ولكن تحديث سطر واحد حتى انهم الانتهاء. هل قضيتك؟

وهنا هو الحال مع رمز 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/;
            }
        }
    }

مستندات بيرل GTK2 لمزيد من المعلومات

وأنا استخدم هذا الروتين الفرعي، وطريقة للدخول بلدي أوامر خارجية. يسمى مثل هذا:

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

وأبسط طريقة لتشغيل عملية طفل مع السيطرة الكاملة على مدخلاته والإخراج وحدة IPC::Open2 (أو IPC::Open3 إذا كنت تريد التقاط STDERR كذلك)، ولكن المشكلة إذا كنت ترغب في التعامل مع متعددة في وقت واحد، أو خاصة إذا كنت تريد أن تفعل ذلك في واجهة المستخدم الرسومية، يتم حظر. إذا كنت تفعل مجرد نوع <$fh> قراءتها يجري لمنع حتى يكون لديك المدخلات، ويحتمل أن تكون التوتيد UI كله. إذا كانت عملية طفل تفاعلية انها أسوأ من ذلك لأنه يمكنك بسهولة طريق مسدود، مع كل من الطفل والأم انتظار إدخال من جهة أخرى. يمكنك كتابة بك select حلقة الخاصة والقيام توصيل nonblocking I / O، ولكن هذا ليس حقا يستحق كل هذا العناء. سيكون اقتراحي لاستخدام POE، POE::Wheel::Run على التفاعل مع العمليات التابعة، وPOE::Loop::Gtk الذي يقضي بدمج POE في runloop GTK.

مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top