Change Engine::write() to use IO::Select instead of worrying about EWOULDBLOCK

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index 089a959..9b59c7d 100644 (file)
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -4,10 +4,10 @@ use strict;
 use base 'Class::Accessor::Fast';
 use CGI::Simple::Cookie;
 use Data::Dump qw/dump/;
-use Errno 'EWOULDBLOCK';
 use HTML::Entities;
 use HTTP::Body;
 use HTTP::Headers;
+use IO::Select ();
 use URI::QueryParam;
 use Scalar::Util ();
 
@@ -622,30 +622,29 @@ sub write {
         $self->{_prepared_write} = 1;
     }
     
-    my $len   = length($buffer);
-    my $wrote = syswrite STDOUT, $buffer;
+    my $wrote;
+    my $len = length($buffer);
     
-    if ( !defined $wrote && $! == EWOULDBLOCK ) {
-        # Unable to write on the first try, will retry in the loop below
-        $wrote = 0;
-    }
+    my $sel = IO::Select->new();
+    $sel->add( \*STDOUT );
     
-    if ( defined $wrote && $wrote < $len ) {
-        # We didn't write the whole buffer
-        while (1) {
-            my $ret = syswrite STDOUT, $buffer, $CHUNKSIZE, $wrote;
-            if ( defined $ret ) {
-                $wrote += $ret;
-            }
-            else {
-                next if $! == EWOULDBLOCK;
-                return;
-            }
-            
-            last if $wrote >= $len;
+    while ( $sel->can_write() ) {
+        $wrote ||= 0;
+        
+        my $ret = syswrite STDOUT, $buffer, $CHUNKSIZE, $wrote;
+        if ( defined $ret ) {
+            $wrote += $ret;
         }
+        else {
+            # Write error
+            return;
+        }
+    
+        last if $wrote >= $len;
     }
     
+    $sel->remove( \*STDOUT );
+    
     return $wrote;
 }
 

diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm
index 2a718c4..ec4ad86 100644 (file)
--- a/lib/Catalyst/Engine/HTTP.pm
+++ b/lib/Catalyst/Engine/HTTP.pm
@@ -161,6 +161,7 @@ sub write {
     
     if ( !defined $ret ) {
         $self->{_write_error} = $!;
+        DEBUG && warn "write: Failed to write response ($!)\n";
     }
     else {
         DEBUG && warn "write: Wrote response ($ret bytes)\n";
@@ -284,7 +285,6 @@ sub run {
                 $self->_handler( $class, $port, $method, $uri, $protocol );
             
                 if ( my $error = delete $self->{_write_error} ) {
-                    DEBUG && warn "Write error: $error\n";
                     close Remote;
                     
                     if ( !defined $pid ) {