X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FHTTP%2FDaemon.pm;h=92faf420b7669637389d21e189e19bf974b8c8c9;hb=b4ca0ee8572ea5c33295686b7f786ab5ff43a2b7;hp=ec6ffcd3bc90367c93cbc476445bb7dac1afbeca;hpb=d837e1a7eadff19ff04373ad19d22fa293e19db5;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine/HTTP/Daemon.pm b/lib/Catalyst/Engine/HTTP/Daemon.pm index ec6ffcd..92faf42 100644 --- a/lib/Catalyst/Engine/HTTP/Daemon.pm +++ b/lib/Catalyst/Engine/HTTP/Daemon.pm @@ -3,7 +3,7 @@ package Catalyst::Engine::HTTP::Daemon; use strict; use base 'Catalyst::Engine::HTTP::Base'; -use IO::Socket qw(AF_INET INADDR_ANY SOCK_STREAM SOMAXCONN); +use IO::Socket qw( SOCK_STREAM SOMAXCONN ); =head1 NAME @@ -33,57 +33,65 @@ This class overloads some methods from C. =over 4 -=item $c->run +=item $c->handler =cut -$SIG{'PIPE'} = 'IGNORE'; +sub handler { + my ( $class, $client ) = @_; + + $client->timeout(5); + + while ( my $request = $client->get_request ) { + + $request->uri->scheme('http'); # Force URI::http + $request->uri->host( $request->header('Host') || $client->sockhost ); + $request->uri->port( $client->sockport ); + + my $http = Catalyst::Engine::HTTP::Base::struct->new( + address => $client->peerhost, + request => $request, + response => HTTP::Response->new + ); + + $class->SUPER::handler($http); + + $client->send_response( $http->response ); + } + + $client->close; +} + +=item $c->run + +=cut sub run { my $class = shift; my $port = shift || 3000; + + $SIG{'PIPE'} = 'IGNORE'; + + $HTTP::Daemon::PROTO = 'HTTP/1.0'; # For now until we resolve the blocking + # issues with HTTP 1.1 - my $daemon = Catalyst::Engine::HTTP::Base::struct->new( + my $daemon = Catalyst::Engine::HTTP::Daemon::Catalyst->new( Listen => SOMAXCONN, LocalPort => $port, ReuseAddr => 1, Type => SOCK_STREAM, ); - - unless ($daemon) { - die("Failed to create daemon: $!\n"); + + unless ( defined $daemon ) { + die( qq/Failed to create daemon. Reason: '$!'/ ); } my $base = URI->new( $daemon->url )->canonical; printf( "You can connect to your server at %s\n", $base ); - while ( my $connection = $daemon->accept ) { - - $connection->timeout(5); - - while ( my $request = $connection->get_request ) { - - $request->uri->scheme('http'); # Force URI::http - $request->uri->host( $request->header('Host') || $base->host ); - $request->uri->port( $base->port ); - - my $hostname = gethostbyaddr( $connection->peeraddr, AF_INET ); - - my $http = Catalyst::Engine::HTTP::Base::struct->new( - address => $connection->peerhost, - hostname => $hostname || $connection->peerhost, - request => $request, - response => HTTP::Response->new - ); - - $class->handler($http); - $connection->send_response( $http->response ); - - } - - $connection->close; - undef($connection); + while ( my $client = $daemon->accept ) { + $class->handler($client); } } @@ -106,7 +114,7 @@ the same terms as Perl itself. =cut -package Catalyst::Engine::HTTP::Catalyst; +package Catalyst::Engine::HTTP::Daemon::Catalyst; use strict; use base 'HTTP::Daemon';