[Catalyst-commits] r7044 -
trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket
andyg at dev.catalyst.perl.org
andyg at dev.catalyst.perl.org
Mon Oct 22 18:53:52 GMT 2007
Author: andyg
Date: 2007-10-22 18:53:52 +0100 (Mon, 22 Oct 2007)
New Revision: 7044
Modified:
trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Server.pm
trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Worker.pm
Log:
Reset the worker when done sending the response, there is probably a more efficient way to do this but it works for now
Modified: trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Server.pm
===================================================================
--- trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Server.pm 2007-10-22 17:46:52 UTC (rev 7043)
+++ trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Server.pm 2007-10-22 17:53:52 UTC (rev 7044)
@@ -34,11 +34,13 @@
$self => [ qw(
_start
+ sig_int
+ sig_child
+
child_error
child_closed
child_stdout
child_stderr
- sig_child
) ],
],
);
@@ -51,6 +53,8 @@
$kernel->alias_set( "$self" );
+ $kernel->sig( INT => 'sig_int' );
+
# Fork child proc(s)
$self->{children} = {};
$self->{child_busy} = {};
@@ -91,6 +95,14 @@
return $self;
}
+sub sig_int {
+ my ( $kernel, $self ) = @_[ KERNEL, OBJECT ];
+
+ for my $child ( values %{ $self->{children} } ) {
+ $child->kill();
+ }
+}
+
### Sprocket server methods
sub local_connected {
@@ -115,13 +127,13 @@
# XXX: Static requests should be handled directly with AIO
# If this connection is now handling body data, just pass it along
- if ( my $id = $con->{_body_mode} ) {
+ if ( my $id = $con->x->{body_mode} ) {
DEBUG && warn "[$id] Passed along " . length($req) . " bytes of body data\n";
$self->{children}->{ $id }->put( $req );
return 1;
}
- warn "local_receive: " . dump($req) . "\n";
+ DEBUG && warn "local_receive: " . dump($req) . "\n";
# Find a free child to send the request to
for my $id ( keys %{ $self->{children} } ) {
@@ -147,15 +159,15 @@
$self->{children}->{ $id }->set_stdin_filter( POE::Filter::Stream->new() );
- $con->{_body_mode} = $id;
+ $con->x->{body_mode} = $id;
# Existing body data in the filter's buffer will be ready immediately,
# additional data will come in through this method, we will detect this with
- # the _body_mode flag
+ # the body_mode flag
}
# Get pending data out of the HeadersOnly filter and pass it along
my $pending = $con->filter->get_pending();
- if ( @{$pending} ) {
+ if ( @{$pending} && $pending->[0] ) {
DEBUG && warn "[$id] Passed along " . length( $pending->[0] ) . " bytes of body data\n";
$self->{children}->{ $id }->put( $pending->[0] );
}
@@ -199,15 +211,53 @@
sub child_stdout {
my ( $kernel, $self, $input, $wheel_id ) = @_[ KERNEL, OBJECT, ARG0, ARG1 ];
- #DEBUG && warn "Child $wheel_id stdout: $input\n";
+ #DEBUG && warn "Child $wheel_id stdout: " . dump($input) . "\n";
my $con = $self->{child_busy}->{ $wheel_id };
$con->send( $input );
- # XXX: how best to detect the response has completed so we can
- # mark the child as free to handle another request
-}
+ if ( $input =~ /Content-Length:\s+(\d+)/i ) {
+ # The header chunk, remember the body length
+ $con->x->{length} = $1;
+ $con->x->{sent} = 0;
+
+ DEBUG && warn "[$wheel_id] Starting response with length: " . $con->x->{length} . "\n";
+
+ # Any data in this chunk past \r\n\r\n is body data
+ if ( $input =~ /\x0D\x0A\x0D\x0A(.+)/s ) {
+ $con->x->{sent} = length $1;
+ DEBUG && warn "[$wheel_id] Sent " . $con->x->{sent} . " bytes after header\n";
+ }
+ }
+ else {
+ # Body chunk(s), count bytes sent
+ my $sent = length $input;
+ $con->x->{sent} += $sent;
+
+ DEBUG && warn "[$wheel_id] Sent $sent bytes\n";
+ }
+
+ if ( $con->x->{sent} >= $con->x->{length} ) {
+ # All done sending the body, reset for the next request
+ DEBUG && warn "[$wheel_id] Done sending " . $con->x->{sent} . " bytes, resetting\n";
+
+ delete $con->x->{sent};
+ delete $con->x->{length};
+
+ # Push the HeadersOnly filter back on for the next request
+ $con->filter->push(
+ POE::Filter::HTTPD::HeadersOnly->new(
+ headers_only => 1,
+ )
+ );
+
+ # This child is free again
+ $self->{child_busy}->{ $wheel_id } = 0;
+
+ # XXX: keep-alive stuff
+ }
+}
sub child_stderr {
my ( $kernel, $self, $input, $wheel_id ) = @_[ KERNEL, OBJECT, ARG0, ARG1 ];
Modified: trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Worker.pm
===================================================================
--- trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Worker.pm 2007-10-22 17:46:52 UTC (rev 7043)
+++ trunk/Catalyst-Engine-HTTP-Sprocket/lib/Catalyst/Engine/HTTP/Sprocket/Worker.pm 2007-10-22 17:53:52 UTC (rev 7044)
@@ -6,7 +6,7 @@
use base qw(Catalyst::Engine::CGI);
use Data::Dump qw(dump);
-use HTTP::Status qw(status_message);
+use HTTP::Response;
use NEXT;
use POE::Filter::Reference;
@@ -14,7 +14,8 @@
my ( $class, $config ) = @_;
bless {
- config => $config,
+ config => $config,
+ filter => POE::Filter::Reference->new(),
body => '',
}, $class;
}
@@ -34,17 +35,16 @@
$SIG{__WARN__} = 'DEFAULT';
$SIG{__DIE__} = 'DEFAULT';
- my $filter = POE::Filter::Reference->new();
-
# Change the Catalyst Engine class to us
my $self = __PACKAGE__->new( $config );
-
$config->{appclass}->engine( $self );
my %copy_of_env = %ENV;
+ #my $filter = POE::Filter::Reference->new();
+
while ( sysread STDIN, my $buf = '', 1024 ) {
- my $req = $filter->get( [ $buf ] );
+ my $req = $self->{filter}->get( [ $buf ] );
if ( @{$req} ) {
$req = $req->[0];
@@ -83,8 +83,8 @@
} );
# Pull out any pending data from the filter for use by read_chunk
- my $pending = $filter->get_pending();
- if ( @{$pending} ) {
+ my $pending = $self->{filter}->get_pending();
+ if ( defined $pending && @{$pending} ) {
$self->{body} = $pending->[0];
}
@@ -97,13 +97,18 @@
sub finalize_headers {
my ( $self, $c ) = @_;
- my $protocol = $c->request->protocol;
- my $status = $c->response->status;
- my $message = status_message($status);
+ $self->NEXT::finalize_headers($c);
- *STDOUT->syswrite( "$protocol $status $message\015\012" );
+ # Remove the buffered header data so it's not sent during write()
+ delete $self->{_header_buf};
- $self->NEXT::finalize_headers($c);
+ my $res = HTTP::Response->new(
+ $c->res->status, undef, $c->res->headers
+ );
+
+ $res->protocol( $c->req->protocol );
+
+ syswrite STDOUT, $res->as_string( "\x0D\x0A" );
}
sub read_chunk {
More information about the Catalyst-commits
mailing list