From 6c8213bbffbcc8e50d2925495e557683ddd0e54b Mon Sep 17 00:00:00 2001
From: Andrew Ruthven <andrew@etc.gen.nz>
Date: Thu, 3 Mar 2011 22:37:37 +1300
Subject: [PATCH] It seems that the use of SIG{ALRM} doesn't always work with
 LWP, try another method.

---
 bin/mythtv-status | 28 ++++++++++++++++++++--------
 1 file changed, 20 insertions(+), 8 deletions(-)

diff --git a/bin/mythtv-status b/bin/mythtv-status
index 24a9b83..bfa5ef5 100755
--- 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;
-- 
2.30.2