Tiempo de espera verdadero en LWP :: Método de solicitud de UserAgent

Estoy tratando de implementar una solicitud a un servidor poco confiable. Es agradable tener la solicitud, pero no es 100% necesaria para que mi script perl se complete con éxito. El problema es que el servidor ocasionalmente se estancará (estamos tratando de averiguar por qué) y la solicitud nunca tendrá éxito. Como el servidor piensa que está en vivo, mantiene la conexión de socket abierta, por lo que el valor de tiempo de espera de LWP :: UserAgent no nos sirve de nada. ¿Cuál es la mejor manera de aplicar un tiempo de espera absoluto en una solicitud?

Para su información, esto no es un problema de DNS. El punto muerto tiene algo que ver con una gran cantidad de actualizaciones que llegan a nuestra base de datos de Postgres al mismo tiempo. Para fines de prueba, esencialmente hemos puesto una línea while (1) {} en el controlador de respuestas del servidor.

Actualmente, el código se ve así:

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);

He intentado usar señales para activar un tiempo de espera, pero eso no parece funcionar.

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

La respuesta final que voy a usar fue propuesta por alguien fuera de línea, pero lo mencionaré aquí. Por alguna razón, SigAction funciona mientras que $ SIG (ALRM) no. Todavía no estoy seguro de por qué, pero esto ha sido probado para que funcione. Aquí hay dos versiones de trabajo:

# 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_timeout\n";
    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;
    }
}