How to enforce a definite timeout in perl?

Question

I am using LWP to download content from web pages, and I would like to limit the amount of time it waits for a page.

my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->env_proxy;
$response = $ua->get("http://XML File");
$content = $response->decoded_content;

The problem is that the server will occasionally deadlock (we're trying to figure out why) and the request will never succeed. Since the server thinks it is live, it keeps the socket connection open thus LWP::UserAgent's timeout value does us no good what-so-ever. What is the best way to enforce an absolute timeout on a request?

Whenever the timeout reaches its limit, it just dies and I can't continue on with the script! This whole script is in a loop, where it has to fetch XML files sequentially. I'd really like to handle this timeout properly and make the script continue to next address. Does anyone know how to do this? Thanks!!

Answer 1

I've faced a similar issue before in https://stackoverflow.com/a/10318268/1331451.

What you need to do is add a $SIG{ALRM} handler and use alarm to call it. You set the alarm before you do the call and cancel it directly afterwards. Then you can look at the HTTP::Result you get back.

The alarm will trigger the signal, and Perl will call the signal handler. In it, you can either do stuff directly and die or just die. The eval is for the die no to break the whole program. If the signal handler is called, the alarm is reset automatically.

You could also add different die messages to the handler and differentiate later on with $@ like @larsen said in his answer.

Here's an example:

my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new;
my $res;
eval {
  # custom timeout (strace shows EAGAIN)
  # see https://stackoverflow.com/a/10318268/1331451
  local $SIG{ALRM} = sub {
    # This is where it dies
    die "Timeout occured...";
  }; # NB: \n required
  alarm 10;
  $res = $ua->request($req);
  alarm 0;
};
if ($res && $res->is_success) {
  # the result was a success
}

• perlipc for signals.

Answer 2

In general, you can use an eval block if you want to trap and control sections of code that may die.

while( … ) { # this is your main loop
    eval {
        # here the code that can die
    };
    if ($@) {
        # if something goes wrong, the special variable $@ 
        # contains the error message (as a string or as a blessed reference,
        # it depends on how the invoked code threats the exception.
    }
}

You can find further info in the documentation for the eval function