How to exit child fork process correctly if error encountered when connected to oracle database using perl - linux

Question

I have recently been using perl (v5.10.1) on a Linux system to connect to a database and perform some tasks.
To do this more efficiently I have been using fork() to be able to perform the tasks in parallel. Whilst doing this I have noticed some problems if the child exits with some sort of error (killed by kill command, dies etc.)
I have searched the forum for possible explanations but have not found anything related to using fork() while connected to a database.
Below is my initial program structure. My actual code is more complex but this simplified code illustrates the idea.
use strict;
use warnings;
use utf8;
use APR::UUID ;
use DBI ;
use DBD::Oracle ;
use Data::Dumper;
$ENV{'ORACLE_HOME'} = "/home/data/ora11g2" ;
$ENV{'NLS_LANG'} = "french_france.AL32UTF8" ;
$ENV{'LANG'} = "fr_FR.utf-8" ;
my $IDJOB = APR::UUID->new->format ;
my $DB="DB_val";
my $SRV="SRV_val";
my %attr = (
PrintError => 1,
RaiseError => 0
);
my %attr_CHILD = (
PrintError => 1,
RaiseError => 0
);
my $db = DBI->connect("dbi:Oracle:$SRV/$DB", "user", "pword", \%attr ) or die "impossible de se connecter à $SRV / $DB";
$db->{AutoCommit} = 0 ;
$db->{InactiveDestroy} = 1; # This needs to be set to 1 if any parallel processing will be used.
# Otherwise database is disconnected in parent after children have finished.
my $Crash_Error_String='';
my #Res1;
eval{#Res1=Mainsub($db)};
#
$Crash_Error_String=$# unless #Res1 ;
$Res1[0] = 501 unless #Res1 ;
print "ERROR code:" . $Res1[0] . " (Error string:$Crash_Error_String)\n";
$db->commit if defined($db) ;
$db->disconnect if defined($db) ;
#
#
#
sub Mainsub{
my $db=shift;
#
my $Program_Termination_Code=0;
my #Results=(0,0,0,0);
my $Processes_To_Use_After_Calc=4;
my $fh1PR_E_filename_STEM="/tmp/error_file_Test_parallel_rows_" . $IDJOB . "_";
my $forked = 0;
my $err = 0;
my #child_pids_rows;
my #child_ispawns_rows;
my $start = time;
for my $ispawn (1 .. $Processes_To_Use_After_Calc){
my $ispawn_XML=$ispawn-1;
my $child_pid = fork();
if(!defined $child_pid){
$err++
} else {
push #child_pids_rows,$child_pid;
push #child_ispawns_rows,$ispawn;
}
if(defined $child_pid && $child_pid > 0) {
## Parent
$forked++;
} elsif(defined $child_pid){
my $db_child;
my $fh1PR_E_filename=$fh1PR_E_filename_STEM . $ispawn . ".err";
#$SIG{__DIE__} = $SIG{TERM} = $SIG{INT} = sub {
# my $ERROR_Val=$!;
# open(my $fh1PR_E, '>:encoding(UTF-8)', $fh1PR_E_filename);
# print $fh1PR_E "Caught an errorsignal: $ERROR_Val (child $ispawn)";
# close $fh1PR_E;
# $db_child->commit unless $db_child->{AutoCommit};
# $db_child->disconnect if defined($db_child);
# exit;
#};
my $ERROR_Code_child=0;
$db_child = DBI->connect("dbi:Oracle:$SRV/$DB", "user", "pword", \%attr_CHILD ) or die "impossible de se connecter à $SRV / $DB";
$db_child->{AutoCommit} = 0 ;
$db_child->commit unless $db_child->{AutoCommit} ;
#
#
#
#my $ased=4/0 if $ispawn==2 || $ispawn==1;
$db_child->commit unless $db_child->{AutoCommit} ;
$db_child->disconnect if defined($db_child) ;
exit;
} else {
## unable to fork
$err++;
}
}
my $Total_Children_Errors=0;
my $Total_Children_Exited=0;
my $Error_Messages="";
while (scalar #child_pids_rows) {
my $pid = $child_pids_rows[0];
my $ispawn=$child_ispawns_rows[0];
my $kid = waitpid $pid, 0;
my $ERROR_Count=0;
if($kid > 0){
my ($rc, $sig, $core) = ($? >> 8, $? & 127, $? & 128);
if ($core){
$ERROR_Count++;
$Total_Children_Errors++;
$Error_Messages eq "" ? $Error_Messages="$pid dumped core" : $Error_Messages=$Error_Messages . "\n" . "$pid dumped core";
} elsif($sig == 9){
$ERROR_Count++;
$Total_Children_Errors++;
$Error_Messages eq "" ? $Error_Messages="$pid was murdered!" : $Error_Messages=$Error_Messages . "\n" . "$pid was murdered!";
} else {
print "$pid returned $rc";
print ($sig?" after receiving signal $sig":"\n");
my $fname=$fh1PR_E_filename_STEM . $ispawn . ".err";
if(-f "$fname"){
$Total_Children_Errors++;
$ERROR_Count++;
if($Error_Messages eq ""){
$Error_Messages="Error found in parallel row process $ispawn (see file " . $fh1PR_E_filename_STEM . $ispawn . ".err for details)";
} else {
$Error_Messages=$Error_Messages . "\n" . "Error found in parallel row process $ispawn (see file " .
$fh1PR_E_filename_STEM . $ispawn . ".err for details)";
}
}
}
} else {
$ERROR_Count++;
$Total_Children_Errors++;
$Error_Messages eq "" ? $Error_Messages="$pid... um... disappeared..." : $Error_Messages=$Error_Messages . "\n" . "$pid... um... disappeared...";
}
$Total_Children_Exited++;
if($ERROR_Count==0){
print "Child $pid exited successfully (" . eval($forked-$Total_Children_Exited) . " of " . $forked . " Children left)\n";
} else {
print "Child $pid exited with ERROR! (" . eval($forked-$Total_Children_Exited) . " of " . $forked . " Children left)\n";
}
shift #child_pids_rows;
shift #child_ispawns_rows;
}
#print "Total child errors:$Total_Children_Errors\n";
if($Total_Children_Errors>0){
$Program_Termination_Code=915;
print $Error_Messages . "\n";
#Results=($Program_Termination_Code,0,0);
goto END101;
} else {
if($err > 0){
$Program_Termination_Code=919;
#Results=($Program_Termination_Code,0,0);
goto END101;
} else {
print "ALL Child processes terminated correctly (Parallel Rows)!\n";
}
}
END101:
return #Results;
}
Running this code produces the output:
27713 returned 0
Child 27713 exited successfully (3 of 4 Children left)
27714 returned 0
Child 27714 exited successfully (2 of 4 Children left)
27715 returned 0
Child 27715 exited successfully (1 of 4 Children left)
27716 returned 0
Child 27716 exited successfully (0 of 4 Children left)
ALL Child processes terminated correctly (Parallel Rows)!
ERROR code:0 (Error string:)
So far no problems. However, now I introduce a deliberate division by zero error in the child process by uncommenting the line (see original code above)
my $ased=4/0 if $ispawn==2 || $ispawn==1;
Now I get the output
ERROR code:501 (Error string:Illegal division by zero at /home/public/AGO/testcode/BArt_F/perl/DB_forking_with_errors_test_code_1.pl line 83.)
ERROR code:501 (Error string:Illegal division by zero at /home/public/AGO/testcode/BArt_F/perl/DB_forking_with_errors_test_code_1.pl line 83.)
30744 returned 0
Child 30744 exited successfully (3 of 4 Children left)
30745 returned 0
Child 30745 exited successfully (2 of 4 Children left)
30746 returned 0
Child 30746 exited successfully (1 of 4 Children left)
30747 returned 0
Child 30747 exited successfully (0 of 4 Children left)
ALL Child processes terminated correctly (Parallel Rows)!
ERROR code:0 (Error string:)
DBD::Oracle::db commit failed: ORA-03113: fin de fichier sur canal de communication
ID de processus : 22739
ID de session : 1, Numéro de série : 54727 (DBD ERROR: OCITransCommit) at /home/public/AGO/testcode/BArt_F/perl/DB_forking_with_errors_test_code_1.pl line 35.
Here I have lost the connection to the database in the parent and the code does not terminate correctly!
Finally, to sort this out, I uncomment the code in the child process (see original code above):
$SIG{__DIE__} = $SIG{TERM} = $SIG{INT} = sub {
my $ERROR_Val=$!;
open(my $fh1PR_E, '>:encoding(UTF-8)', $fh1PR_E_filename);
print $fh1PR_E "Caught an errorsignal: $ERROR_Val (child $ispawn)";
close $fh1PR_E;
$db_child->commit unless $db_child->{AutoCommit};
$db_child->disconnect if defined($db_child);
exit;
};
Now running the code I get:
946 returned 0
Child 946 exited with ERROR! (3 of 4 Children left)
947 returned 0
Child 947 exited with ERROR! (2 of 4 Children left)
948 returned 0
Child 948 exited successfully (1 of 4 Children left)
949 returned 0
Child 949 exited successfully (0 of 4 Children left)
Error found in parallel row process 1 (see file /tmp/error_file_Test_parallel_rows_53a6e838-def0-11eb-b482-8f8e0f0aecb2_1.err for details)
Error found in parallel row process 2 (see file /tmp/error_file_Test_parallel_rows_53a6e838-def0-11eb-b482-8f8e0f0aecb2_2.err for details)
ERROR code:915 (Error string:)
Now the error is trapped and the parent exits correctly.
All of this seems fine until I have read (https://www.perlmonks.org/?node_id=1173708) that I should not use
$SIG{__DIE__}
However I cannot find any alternative method that allows my parent program to exit correctly if any of the child processes die.
Could anyone tell me if there is an alternative method to using
$SIG{__DIE__}