I have aplication which runs in parallel mode. Jobs are runing using threads with implmented subroutine. Subroutine "worker3" have three argumens, one parameter and two path for files. This subroutine execute R script using system commands.
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();
}
Problem is when R script finish with Execution halted, application final status is ok. What i need is when R script finished with error, the whole program needs to be stopped. So, if one thread fails, application needs to stops, and display error.
This is output:
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
----------------------------------------------------
As you see, it shows that application finished OK, no matter if is the error inside R code. I need this : if pushed thread had exception -> stop application perl
CodePudding user response：
Here is an example of how you can stop the main program with a status message if one of the executables run by a given thread fails:
First, I constructed a dummy executable foo.pl like this:
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;
}
Then the main program like this:
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;
}
}
When setting $force_fail = 1 on line 9 of the main script, the output is:
joining thread 0..
thread 0 exited with return value 2
detaching thread 1..
Program failed after 2 seconds
On the other hand, when setting $force_fail = 0 the output is:
joining thread 0..
joining thread 1..
Program succeeded after 5 seconds
CodePudding user response：
@Hakon I modified your code a little
if ($ENV{"model"} eq "alaef_cy40_5km"){
for('T2m','RH2m'){
my $thr = threads -> create(
sub{
my $parameter2 = $_[0];
$ENV{"grb_path"} = $models{$model}{"grb"}{"path"}{$parameter2};
$ENV{"grb_file"} = $models{$model}{"grb"}{"file"}{$parameter2};
my $res = system "Rscript $root/read_ALAEF.R @_ ";
},
$_,$ENV{"grb_file"},$ENV{"grb_path"}
);
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 ($res == -1) {
say "thread $i failed to execute: $!";
exit(1);
}
elsif ($res & 127) {
printf "thread $i died from signal %d\n", $res & 127;
exit(1);
}else{
my $rcode = $res >> 8;
if ($rcode != 0) {
say "thread $i exited with return value $rcode";
exit(1);
}
exit(0);
}
}
}
}
Jobs finished, but i got this error, and application failed:
Can't return outside a subroutine at /users/p6095/app/harp/bin/run.pl line 606.
joining thread 0..
thread 0 exited with return value 1
Perl exited with active threads:
0 running and unjoined
1 finished and unjoined
0 running and detached