stop application if pushed thread had exception in Perl - r

Question

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

Answer 1

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