[Catalyst-commits] r7020 - in Catalyst-Runtime/5.70/trunk/lib/Catalyst: . Engine

[andyg at dev.catalyst.perl.org]

Author: andyg
Date: 2007-10-16 20:06:52 +0100 (Tue, 16 Oct 2007)
New Revision: 7020

Modified:
   Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine.pm
   Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine/HTTP.pm
Log:
Change Engine::write() to use IO::Select instead of worrying about EWOULDBLOCK

Modified: Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine/HTTP.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine/HTTP.pm	2007-10-16 19:04:40 UTC (rev 7019)
+++ Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine/HTTP.pm	2007-10-16 19:06:52 UTC (rev 7020)
@@ -161,6 +161,7 @@
     
     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 @@
                 $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 ) {

Modified: Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine.pm	2007-10-16 19:04:40 UTC (rev 7019)
+++ Catalyst-Runtime/5.70/trunk/lib/Catalyst/Engine.pm	2007-10-16 19:06:52 UTC (rev 7020)
@@ -4,10 +4,10 @@
 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 @@
         $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;
 }