perl DBI超时控制

名字:

Sys::SigAction  Perl 拓展用于一致的信号处理

 #do something non-interrupt able
       use Sys::SigAction qw( set_sig_handler );
       {
          my $h = set_sig_handler( 'INT' ,'mysubname' ,{ flags => SA_RESTART } );
          ... do stuff non-interrupt able
       } #signal handler is reset when $h goes out of scope

摘要:

这个模块实现了"set_sig_handler()", 它设置了一个信号处理器 返回一个导致信号处理器

被重置先先前值的对象

"timeout_call() 是实现通过一个超时参数,一个code引用和可选的参数,

执行代码引用封装使用一个alarm 超时  

描述:

在5.8版本之前, perl实现了不安全的信号处理。

这哥之所以认为不安全,是因为有一个风险 一个信号会到达和辈出当perl时改变内部数据结构。

Perl 5.8.0 和后面的版本实现了安全的信号处理在支持POSIX sigaction() function.

来自PERL 5.8.2 手册页:


因此  'deferred signal'  方法导致一些系统调用被重试在信号之前被调用

这个打破了 DBD-ORACLE的超时逻辑 

对于早期的PERL版本,这个可以是特别恼火的,

对于实例,当主机是不可达的:

 "DBI->connect()" hangs 几分钟在返回错误前
 
 (甚至不能用control-C中断)
 
这是因为信号出现被延迟 结果是不能实现超时 

[oracle@yyjk sbin]$ cat testdbi2.pl 
use DBI;
no warnings;

use DBI;
use HTTP::Date qw(time2iso str2time time2iso time2isoz);
use Net::SMTP;
use Encode;
use JSON;
my $dbip='10.2.120.192';
my $dbname='uacdb';
my $dbuser='uac';
my $dbpass='uac_123';
$dbh1 = DBI->connect( "dbi:Oracle://$dbip:1521/$dbname", $dbuser, $dbpass );
[oracle@yyjk sbin]$ time perl testdbi2.pl 
DBI connect('//10.2.120.192:1521/uacdb','uac',...) failed: ORA-12170: TNS: 连接超时 (DBD ERROR: OCIServerAttach) at testdbi2.pl line 13.

real    1m0.186s
user    0m0.101s
sys    0m0.015s

  Or as the author of bug #50628 pointed out, might probably better be
    written as:

       eval {
          local $SIG{ALRM} = sub { die "timeout" };
          eval {
             alarm 2;
             $sth = DBI->connect(...);
             alarm 0;
          };
          alarm 0;
          die if $@;
       };


[oracle@yyjk sbin]$ cat testdbi1.pl 
use DBI;
no warnings;

use DBI;
use HTTP::Date qw(time2iso str2time time2iso time2isoz);
use Net::SMTP;
use Encode;
use JSON;
use Sys::SigAction qw( set_sig_handler );
my $dbip='10.2.120.192';
my $dbname='uacdb';
my $dbuser='uac';
my $dbpass='uac';
eval {
     my $h = set_sig_handler( 'ALRM' ,sub { die; } ); #数据库连接超时后的返回结果
       alarm(5); #设置为5秒超时
      $dbh1 = DBI->connect( "dbi:Oracle://$dbip:1521/$dbname", $dbuser, $dbpass );
      alarm(0);
     };a
if ($@){
   print '11111111111111'."\n";
}
else{
  print '222222222222222'."\n";
};
You have mail in /var/spool/mail/oracle
[oracle@yyjk sbin]$ 
[oracle@yyjk sbin]$ time perl testdbi1.pl 
11111111111111

real    0m5.104s
user    0m0.100s
sys    0m0.019s