如何解决使用perl连接oracle数据库时遇到错误如何正确退出子fork进程
我最近在 Linux 系统上使用 perl (v5.10.1) 连接到数据库并执行一些任务。
为了更有效地执行此操作，我一直使用 fork() 来并行执行任务。在执行此操作时，如果孩子退出时出现某种错误（被 kill 命令杀死，死亡等），我注意到了一些问题
我在论坛上搜索了可能的解释，但没有找到与在连接到数据库时使用 fork() 相关的任何信息。
以下是我的初始程序结构。我的实际代码更复杂，但这个简化的代码说明了这个想法。
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);
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",\%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);
goto END101;
} else {
if($err > 0){
$Program_Termination_Code=919;
@Results=($Program_Termination_Code,0);
goto END101;
} else {
print "ALL Child processes terminated correctly (Parallel Rows)!\n";
}
}
END101:
return @Results;
}
运行此代码产生输出：
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:)
目前没有问题。但是，现在我通过取消注释该行（参见上面的原始代码）在子进程中引入了一个被零错误的故意除法
my $ased=4/0 if $ispawn==2 || $ispawn==1;
现在我得到输出
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.
这里我失去了到父级数据库的连接，代码没有正确终止！
最后，为了解决这个问题，我取消注释子进程中的代码（见上面的原始代码）：
$SIG{__DIE__} = $SIG{TERM} = $SIG{INT} = sub {
my $ERROR_Val=$!;
open(my $fh1PR_E,$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;
};
现在运行我得到的代码：
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:)
现在错误被捕获并且父级正确退出。
所有这些看起来都很好，直到我阅读了我不应该使用的 (https://www.perlmonks.org/?node_id=1173708)
$SIG{__DIE__}
但是，如果任何子进程死亡，我找不到任何允许我的父程序正确退出的替代方法。
谁能告诉我是否有其他方法可以使用
$SIG{__DIE__}
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
