我有以并行模式運行的應用程式。作業使用帶有已實作子例程的執行緒運行。子程式“worker3”有三個引數，一個引數和兩個檔案路徑。該子例程使用系統命令執行 R 腳本。
if ($ENV{"model"} eq "alaef_cy40_5km"){
sub worker3 {
my $parameter2 = $_[0];
print $parameter2, "\n";
$ENV{"grb_path"} = $models{$model}{"grb"}{"path"}{$parameter2};
$ENV{"grb_file"} = $models{$model}{"grb"}{"file"}{$parameter2};
print"FROM sub:", "\n";
print $ENV{"grb_path"}, "\n";
print $ENV{"grb_file"}, "\n";
say "Job Started\n";
system("Rscript $root/read_ALAEF.R @_ ");
}
for my $param( 'T2m','RH2m'){
push @threads, my $thr1=threads ->create('worker3', $param ,$ENV{"grb_file"},$ENV{"grb_path"})
}
$_->join() for threads->list();
}
問題是當 R 腳本完成并停止執行時，應用程式最終狀態正常。我需要的是當 R 腳本完成錯誤時，需要停止整個程式。因此，如果一個執行緒失敗，應用程式需要停止并顯示錯誤。
這是輸出：
T2m
FROM sub:
/data/nwp/products/a-laef_stream
A-LAEF_mem_{MBR2}_{YYYY}{MM}{DD}{HH}_surface.grb
Job Started
RH2m
FROM sub:
/data/nwp/products/a-laef_stream
A-LAEF_mem_{MBR2}_{YYYY}{MM}{DD}{HH}_surface.grb
Job Started
-- Attaching packages --------------------------------------- tidyverse 1.3.1 --
v ggplot2 3.3.5 v purrr 0.3.4
v tibble 3.1.6 v dplyr 1.0.7
v tidyr 1.1.4 v stringr 1.4.0
v readr 2.1.0 v forcats 0.5.1
-- Attaching packages --------------------------------------- tidyverse 1.3.1 --
v ggplot2 3.3.5 v purrr 0.3.4
v tibble 3.1.6 v dplyr 1.0.7
v tidyr 1.1.4 v stringr 1.4.0
v readr 2.1.0 v forcats 0.5.1
-- Conflicts ------------------------------------------ tidyverse_conflicts() --
x dplyr::filter() masks stats::filter()
x dplyr::lag() masks stats::lag()
here() starts at /work/users/p6095/2022-02-19_00/harp.119
Loading required package: harpIO
Attaching package: 'harpIO'
The following object is masked from 'package:purrr':
accumulate
Loading required package: harpPoint
Loading required package: harpVis
Loading required package: shiny
-- Conflicts ------------------------------------------ tidyverse_conflicts() --
x dplyr::filter() masks stats::filter()
x dplyr::lag() masks stats::lag()
here() starts at /work/users/p6095/2022-02-19_00/harp.119
Loading required package: harpIO
Attaching package: 'harpIO'
The following object is masked from 'package:purrr':
accumulate
Loading required package: harpPoint
Loading required package: harpVis
Loading required package: shiny
Loading required package: harpSpatial
Error: unexpected string constant in:
"
'4'"
Execution halted
Loading required package: harpSpatial
Error: unexpected string constant in:
"
'4'"
Execution halted
----------------------------------------------------
Application finished OK at: 21-02-2022 15:46:11 UTC
----------------------------------------------------
如您所見，它表明應用程式正常完成，無論是否是 R 代碼中的錯誤。我需要這個：如果推送執行緒有例外-> 停止應用程式 perl
uj5u.com熱心網友回復：
這是一個示例，說明如果給定執行緒運行的可執行檔案之一失敗，您如何通過狀態訊息停止主程式：
首先，我構建了一個foo.pl像這樣的虛擬可執行檔案：
use feature qw(say);
use strict;
use warnings;
my ($id, $force_fail) = @ARGV;
my $thread1_exit_value = $force_fail ? 2 : 0;
if ($id == 1) {
sleep 2;
exit $thread1_exit_value;
}
elsif ($id == 2) {
sleep 5;
exit 0;
}
然后主程式是這樣的：
use v5.20; # experimental signatures requires perl >= 5.20
use feature qw(say);
use strict;
use warnings;
use experimental qw(signatures);
use threads;
{
my @threads;
my $force_fail = 1;
my $start_time = time;
for (1..2) {
my $thr = threads->create(
sub {
my $res = system "foo.pl", $_, $force_fail; $res
}
);
push @threads, $thr;
}
my $fail = 0;
for my $i (0..$#threads) {
my $thr = $threads[$i];
if ($fail) {
say "detaching thread $i..";
$thr->detach();
}
else {
say "joining thread $i..";
my $res = $thr->join();
if (command_failed($res, $i)) {
$fail = 1;
}
}
}
my $total_time = time - $start_time;
say "Program " . ($fail ? "failed" : "succeeded") . " after $total_time seconds";
}
sub command_failed( $res, $id ) {
if ($res == -1) {
say "thread $id failed to execute: $!";
return 1;
}
elsif ($res & 127) {
printf "thread $id died from signal %d\n", $res & 127;
return 1;
}
else {
my $rcode = $res >> 8;
if ($rcode != 0) {
say "thread $id exited with return value $rcode";
return 1;
}
return 0;
}
}
$force_fail = 1在主腳本的第 9 行設定時，輸出為：
joining thread 0..
thread 0 exited with return value 2
detaching thread 1..
Program failed after 2 seconds
另一方面，設定$force_fail = 0輸出時為：
joining thread 0..
joining thread 1..
Program succeeded after 5 seconds
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/432382.html
上一篇：Perl模塊安裝在錯誤的根目錄