From: Andy Grundman Date: Tue, 16 Oct 2007 19:06:52 +0000 (+0000) Subject: Change Engine::write() to use IO::Select instead of worrying about EWOULDBLOCK X-Git-Tag: 5.7099_04~127 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=e2b0ddd34989844e13aa57483888973068d62dbe 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 --- 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 --- 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 ) {