एक लटका बाल प्रक्रिया को मारें

Question

मेरी पर्ल स्क्रिप्ट एक बाहरी प्रोग्राम चलाती है (जो एक एकल कमांड लाइन पैरामीटर लेती है) और इसके आउटपुट को संसाधित करती है। मूल रूप से, मैं यह कर रहा था:

my @result = `prog arg`; 

हालांकि, पता चला है कि कार्यक्रम गाड़ी है और दुर्लभ मामलों में अप्रत्याशित रूप से लटका हुआ है। यदि मैं निश्चित समय के बाद बाहर नहीं निकला तो मैं प्रोग्राम को कैसे मार सकता हूं? स्क्रिप्ट को विंडोज और लिनक्स दोनों में काम करना है, और यह मेरी समझ है कि अलार्म और कांटे विंडोज में अच्छी तरह से काम नहीं करते हैं (या बिल्कुल)।

मुझे IPC::Run नामक एक मॉड्यूल मिला लेकिन मैं यह नहीं समझ सकता कि इसका उपयोग अपने दस्तावेज़ से ठीक से कैसे किया जाए। :-(मैं इस कोशिश की:।

use strict; 
use warnings; 
use IPC::Run qw(run timeout); 
my $in; 
my $out; 
my $err; 
my @result; 
my @cmd = qw(prog arg); 
run \@cmd, \$in, \$out, \$err, timeout (10) or die "@cmd: $?"; 
push @result, $_ while (<$out>); 
close $out; 
print @result; 

एक परीक्षण के रूप में, मैं एक प्रोग्राम है जो सिर्फ 60 सेकंड सोता है, stdout और बाहर निकलता है के लिए एक स्ट्रिंग प्रिंट जब मैं ऊपर कोड के साथ चलाने का प्रयास बनाई, इसके लिए लटकी हुई है 60 सेकंड (के बजाय 10 सेकंड, समय समाप्ति के रूप में विनिर्दिष्ट के लिए) और एक विचित्र त्रुटि के साथ रोकता:

IPC::Run: timeout on timer #1 at C:/Bin/Unix/Perl/site/lib/IPC/Run.pm line 2956 

तो मैं एक और मॉड्यूल, Proc::Reliable पाया वर्णन से, यह ठीक करने के लिए जो मैं चाहता लगता है।। सिवाय इसके कि यह काम नहीं करता है! मैंने कोशिश की:

use strict; 
use warnings; 
use Proc::Reliable; 

my $proc = Proc::Reliable->new(); 
$proc->maxtime (10); 
my $out = $proc->run ("prog arg"); 
print "$out\n"; 

यह वास्तव में 10 सेकंड के बाद बाल प्रक्रिया को रोक देता है। अब तक सब ठीक है. लेकिन फिर मैंने बाहरी कार्यक्रम में संशोधन किया और इसे केवल 5 सेकंड के लिए सोया। इसका मतलब यह है कि कार्यक्रम उपरोक्त कोड में निर्दिष्ट 10-सेकंड टाइमआउट से पहले समाप्त होना चाहिए और इसके stdout आउटपुट को $out वेरिएबल में कैप्चर किया जाना चाहिए। लेकिन यह नहीं है! उपरोक्त स्क्रिप्ट कुछ भी आउटपुट नहीं करता है।

कोई विचार यह कैसे ठीक से करना है? (बग्गी बाहरी कार्यक्रम को ठीक करना एक विकल्प नहीं है।) अग्रिम धन्यवाद।

Answer 1

गरीब आदमी का अलार्म

my $pid; 
if ($^O eq 'MSWin32') { 
    $pid = system 1, "prog arg"; # Win32 only, run proc in background 
} else { 
    $pid = fork(); 
    if (defined($pid) && $pid == 0) { 
     exec("proc arg"); 
    } 
} 

my $poor_mans_alarm = "sleep 1,kill(0,$pid)||exit for 1..$TIMEOUT;kill -9,$pid"; 
system($^X, "-e", $poor_mans_alarm); 

गरीब आदमी का अलार्म एक अलग प्रक्रिया में चलता कोशिश करो। हर सेकेंड, यह जांचता है कि पहचानकर्ता $ pid के साथ प्रक्रिया अभी भी जिंदा है या नहीं। यदि प्रक्रिया जिंदा नहीं है, तो अलार्म प्रक्रिया निकलती है। यदि प्रक्रिया $ 4 सेकंड के बाद भी जीवित है, तो यह प्रक्रिया के लिए एक हत्या संकेत भेजती है (मैंने इसे 9 अप्रयुक्त करने के लिए 9 और पूरे उपप्रजाय पेड़ को निकालने के लिए उपयोग किया था, आपकी जरूरतें अलग-अलग हो सकती हैं। kill 9,... भी पोर्टेबल है)।

संपादित करें: आप गरीब व्यक्ति के अलार्म के साथ प्रक्रिया के आउटपुट को कैप्चर कैसे करते हैं? बैकटिक्स के साथ नहीं - तो आपको प्रक्रिया आईडी नहीं मिल सकती है और यदि प्रक्रिया का समय समाप्त हो जाता है और आप मारे जाते हैं तो आप इंटरमीडिएट आउटपुट खो सकते हैं। विकल्प

1) एक फाइल करने के लिए उत्पादन भेजने के लिए, जब प्रक्रिया

$pid = system 1, "proc arg > some_file"; 
... start poor man's alarm, wait for program to finish ... 
open my $fh, '<', 'some_file'; 
my @process_output = <$fh>; 
... 

2 से किया जाता है) फ़ाइल को पढ़ने पर्ल के open का उपयोग प्रक्रिया शुरू करने के

$pid = open my $proc, '-|', 'proc arg'; 
if (fork() == 0) { 
    # run poor man's alarm in a background process 
    exec($^X, '-e', "sleep 1,kill 0,$pid||exit ..."); 
} 
my @process_output =(); 
while (<$proc>) { 
    push @process_output, $_; 
} 

while पाश हैं होगा समाप्त होता है जब प्रक्रिया समाप्त होती है, या तो स्वाभाविक रूप से या अनैसर्गिक रूप से।

Answer 2

यह सबसे अच्छा है जो मैं कर सकता था।विंडोज़ पर एक अस्थायी फ़ाइल के उपयोग से बचने के तरीके के बारे में कोई भी विचार सराहना की जाएगी।

#!/usr/bin/perl 

use strict; 
use warnings; 
use File::Temp; 
use Win32::Process qw(STILL_ACTIVE NORMAL_PRIORITY_CLASS); 

my $pid; 
my $timeout = 10; 
my $prog = "prog arg"; 
my @output; 

if ($^O eq "MSWin32") 
{ 
    my $exitcode; 
    my $fh = File::Temp->new(); 
    my $output_file = $fh->filename; 
    close ($fh); 
    open (OLDOUT, ">&STDOUT"); 
    open (STDOUT, ">$output_file") || die ("Unable to redirect STDOUT to $output_file.\n"); 
    Win32::Process::Create ($pid, $^X, $prog, 1, NORMAL_PRIORITY_CLASS, '.') or die Win32::FormatMessage (Win32::GetLastError()); 
    for (1 .. $timeout) 
    { 
     $pid->GetExitCode ($exitcode); 
     last if ($exitcode != STILL_ACTIVE); 
     sleep 1; 
    } 
    $pid->GetExitCode ($exitcode); 
    $pid->Kill (0) or die "Cannot kill '$pid'" if ($exitcode == STILL_ACTIVE); 
    close (STDOUT); 
    open (STDOUT, ">&OLDOUT"); 
    close (OLDOUT); 
    open (FILE, "<$output_file"); 
    push @output, $_ while (<FILE>); 
    close (FILE); 
} 
else 
{ 
    $pid = open my $proc, "-|", $prog; 
    exec ($^X, "-e", "sleep 1, kill (0, $pid) || exit for 1..$timeout; kill -9, $pid") unless (fork()); 
    push @output, $_ while (<$proc>); 
    close ($proc); 
} 
print "Output:\n"; 
print @output; 

Answer 3

आप अलार्ड सिस्टम कॉल का उपयोग perldoc -f अलार्म में करना चाह सकते हैं।