Merge branch 'master' of git://git.evergreen-ils.org/OpenSRF

diff --git a/src/perl/lib/OpenSRF.pm b/src/perl/lib/OpenSRF.pm
index b577ecd..33b8c83 100644 (file)
--- a/src/perl/lib/OpenSRF.pm
+++ b/src/perl/lib/OpenSRF.pm
@@ -42,4 +42,21 @@ Returns the scalar value of its caller.
 
 sub class { return scalar(caller); }
 
+=head2 OSRF_APACHE_REQUEST_OBJ
+
+Gets and sets the Apache request object when running inside mod_perl.
+This allows other parts of OpenSRF to investigate the state of the
+remote connection, such as whether the client has disconnected, and
+react accordingly.
+
+=cut
+
+our $_OARO;
+sub OSRF_APACHE_REQUEST_OBJ {
+       my $self = shift;
+       my $a = shift;
+       $_OARO = $a if $a;
+       return $_OARO;
+}
+
 1;

diff --git a/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm b/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
index d1ebfa1..9e15ecd 100644 (file)
--- a/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
+++ b/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
@@ -210,7 +210,31 @@ sub wait {
     my $infile = '';
     vec($infile, $socket->fileno, 1) = 1;
 
-    my $nfound = select($infile, undef, undef, $timeout);
+    my $nfound;
+    if (!OpenSRF->OSRF_APACHE_REQUEST_OBJ || $timeout <= 1.0) {
+        $nfound = select($infile, undef, undef, $timeout);
+    } else {
+        $timeout -= 1.0;
+        for (
+            my $sleep = 1.0;
+            $timeout >= 0.0;
+            do {
+                $sleep = $timeout < 1.0 ? $timeout : 1.0;
+                $timeout -= 1.0;
+            }
+        ) {
+            $nfound = select($infile, undef, undef, $sleep);
+            last if $nfound;
+            if (
+                OpenSRF->OSRF_APACHE_REQUEST_OBJ &&
+                OpenSRF->OSRF_APACHE_REQUEST_OBJ->connection->aborted
+            ) {
+                # Should this be more severe? Die or throw error?
+                $logger->warn("Upstream Apache client disconnected, aborting.");
+                last;
+            };
+        }
+    }
     return undef if !$nfound or $nfound == -1;
 
     # now slurp the data off the socket