It seems that the use of SIG{ALRM} doesn't always work with LWP, try another method.

diff --git a/bin/mythtv-status b/bin/mythtv-status
index 24a9b83d75001329a27922d8607e4261d2d63b8e..bfa5ef5631e62e1ff5654dab3471c1cdffeec3db 100755 (executable)
--- a/bin/mythtv-status
+++ b/bin/mythtv-status
@@ -24,6 +24,7 @@ use POSIX qw/strftime/;
 use MIME::Entity;
 use Pod::Usage;
 use Config::Auto;
+use Sys::SigAction qw/timeout_call/;
 
 # Try and load a config file first, and then allow the command line
 # to over ride what is in the config file.
@@ -646,16 +647,10 @@ sub load_xml {
     my $ua = LWP::UserAgent->new;
     $ua->timeout(30);
     $ua->env_proxy;
-    my $response;
-    eval {
-      local $SIG{ALRM} = sub { die "alarm\n" };
-      alarm(30);
-      $response = $ua->get($url);
-      alarm(0);
-      };
+    my $response = ua_request_with_timeout($ua, $url);
 
     die "Sorry, failed to fetch $url: Connection to MythTV timed out.\n"
-      if $@;
+      unless defined $response;
 
     die "Sorry, failed to fetch $url:\n" . $response->status_line . "\n"
       unless $response->is_success;
@@ -1022,6 +1017,23 @@ sub normalise_disk_space {
   return $_[0];
 }
 
+# Takes a LWP::UserAgent, and a HTTP::Request, returns a HTTP::Request
+# Based on:
+# http://stackoverflow.com/questions/73308/true-timeout-on-lwpuseragent-request-method
+sub ua_request_with_timeout {
+  my ($ua, $url) = @_;
+
+  # 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.)
+  our $res = undef;
+  if( timeout_call( $ua->timeout(), sub {$res = $ua->get($url);}) ) {
+      return undef;
+  } else {
+      return $res;
+  }
+}
+
 # Beautify numbers by sticking commas in.
 sub commify {
   my ($num) = shift;