=head2 $self->write($c, $buffer)
-Writes the buffer to the client. Can only be called once for a request.
+Writes the buffer to the client.
=cut
sub write {
my ( $self, $c, $buffer ) = @_;
- # Avoid 'print() on closed filehandle Remote' warnings when using IE
- return unless *STDOUT->opened();
-
- my $ret;
-
- # Prepend the headers if they have not yet been sent
- if ( my $headers = delete $self->{_header_buf} ) {
- DEBUG && warn "write: Wrote headers and first chunk (" . length($headers . $buffer) . " bytes)\n";
- $ret = $self->NEXT::write( $c, $headers . $buffer );
- }
- else {
- DEBUG && warn "write: Wrote chunk (" . length($buffer) . " bytes)\n";
- $ret = $self->NEXT::write( $c, $buffer );
+ # Avoid 'print() on closed filehandle Remote' warnings when using IE
+ return unless *STDOUT->opened();
+
+ # Prepend the headers if they have not yet been sent
+ if ( my $headers = delete $self->{_header_buf} ) {
+ $buffer = $headers . $buffer;
}
- if ( !$ret ) {
+ my $ret = $self->NEXT::write( $c, $buffer );
+
+ if ( !defined $ret ) {
$self->{_write_error} = $!;
+ DEBUG && warn "write: Failed to write response ($!)\n";
+ }
+ else {
+ DEBUG && warn "write: Wrote response ($ret bytes)\n";
}
return $ret;
if ($options->{background}) {
my $child = fork;
die "Can't fork: $!" unless defined($child);
- exit if $child;
+ return $child if $child;
}
my $restart = 0;
if ( !$self->_read_headers ) {
# Error reading, give up
+ close Remote;
next LISTEN;
}
my ( $method, $uri, $protocol ) = $self->_parse_request_line;
+
+ next unless $method;
DEBUG && warn "Parsed request: $method $uri $protocol\n";
-
- next unless $method;
unless ( uc($method) eq 'RESTART' ) {
# Fork
- if ( $options->{fork} ) { next if $pid = fork }
+ if ( $options->{fork} ) {
+ if ( $pid = fork ) {
+ DEBUG && warn "Forked child $pid\n";
+ next;
+ }
+ }
$self->_handler( $class, $port, $method, $uri, $protocol );
if ( my $error = delete $self->{_write_error} ) {
- DEBUG && warn "Write error: $error\n";
close Remote;
- next LISTEN;
+
+ if ( !defined $pid ) {
+ next LISTEN;
+ }
}
- $daemon->close if defined $pid;
+ if ( defined $pid ) {
+ # Child process, close connection and exit
+ DEBUG && warn "Child process exiting\n";
+ $daemon->close;
+ exit;
+ }
}
else {
my $sockdata = $self->_socket_data( \*Remote );
last;
}
}
-
- exit if defined $pid;
}
continue {
close Remote;
use Config;
$ENV{PERL5LIB} .= join $Config{path_sep}, @INC;
- exec $^X . ' "' . $0 . '" ' . join( ' ', @{ $options->{argv} } );
+ exec $^X, $0, @{ $options->{argv} };
}
exit;
$sel->add( \*STDIN );
REQUEST:
- # Initialize CGI environment
- local %ENV = (
- PATH_INFO => $path || '',
- QUERY_STRING => $query_string || '',
- REMOTE_ADDR => $sockdata->{peeraddr},
- REMOTE_HOST => $sockdata->{peername},
- REQUEST_METHOD => $method || '',
- SERVER_NAME => $sockdata->{localname},
- SERVER_PORT => $port,
- SERVER_PROTOCOL => "HTTP/$protocol",
- %copy_of_env,
- );
-
+ while (1) {
+ my ( $path, $query_string ) = split /\?/, $uri, 2;
+
# Initialize CGI environment
local %ENV = (
PATH_INFO => $path || '',
while (1) {
my $read = sysread Remote, my $buf, CHUNKSIZE;
-
- if ( !$read ) {
- DEBUG && warn "EOF or error: $!\n";
+
+ if ( !defined $read ) {
+ next if $! == EWOULDBLOCK;
+ DEBUG && warn "Error reading headers: $!\n";
+ return;
+ }
+ elsif ( $read == 0 ) {
+ DEBUG && warn "EOF\n";
return;
}