perl – LWP :: UserAgent请求方法的真实超时

我试图向不可靠的服务器执行一个请求.该请求是一个很好的,但不是100％需要我的perl脚本成功完成.问题是服务器偶尔会死机(我们正在试图找出原因),请求永远不会成功.由于服务器认为它是活的,它保持套接字连接打开,因此LWP :: UserAgent的超时值使我们没有什么好的.在请求上执行绝对超时的最佳方式是什么？

FYI,这不是一个DNS问题.死锁与大量更新同时处理Postgres数据库有关.为了测试目的,我们已经在服务器响应处理程序中基本上放了一段时间(1){}行.

目前,代码如下：

my $ua = LWP::UserAgent->new;
ua->timeout(5); $ua->cookie_jar({});

my $req = HTTP::Request->new(POST => "http://$host:$port/auth/login");
$req->content_type('application/x-www-form-urlencoded');
$req->content("login[user]=$username&login[password]=$password");

# This line never returns 
$res = $ua->request($req);

我尝试使用信号触发超时,但这似乎不起作用.

eval {
    local $SIG{ALRM} = sub { die "alarmn" };
    alarm(1);
    $res = $ua->request($req);
    alarm(0);
};
# This never runs
print "heren";

我将要使用的最终答案是由离线人员提出的,但我会在这里提及.由于某些原因,SigAction可以工作,而$SIG(ALRM)则不起作用.仍然不知道为什么,但这已经测试工作.这里有两个工作版本：

# Takes a LWP::UserAgent,and a HTTP::Request,returns a HTTP::Request
sub ua_request_with_timeout {
    my $ua = $_[0];
    my $req = $_[1];
    # Get whatever timeout is set for LWP and use that to 
    #  enforce a maximum timeout per request in case of server
    #  deadlock. (This has happened.)
    use Sys::SigAction qw( timeout_call );
    our $res = undef;
    if( timeout_call( 5,sub {$res = $ua->request($req);}) ) {
        return HTTP::Response->new( 408 ); #408 is the HTTP timeout
    } else {
        return $res;
    }
}
sub ua_request_with_timeout2 {
    print "ua_request_with_timeoutn";
    my $ua = $_[0];
    my $req = $_[1];
    # Get whatever timeout is set for LWP and use that to 
    #  enforce a maximum timeout per request in case of server
    #  deadlock. (This has happened.)
    my $timeout_for_client = $ua->timeout() - 2;
    our $socket_has_timedout = 0;

    use POSIX;
    sigaction SIGALRM,new POSIX::SigAction(
                                            sub {
                                                $socket_has_timedout = 1;
                                                die "alarm timeout";
                                            }
                                            ) or die "Error setting SIGALRM handler: $!n";
    my $res = undef;
    eval {
        alarm ($timeout_for_client);
        $res = $ua->request($req);
        alarm(0);
    };
    if ( $socket_has_timedout ) {
        return HTTP::Response->new( 408 ); #408 is the HTTP timeout
    } else {
        return $res;
    }
}