1 package Catalyst::Engine::HTTP::Daemon;
4 use base 'Catalyst::Engine::HTTP::Base';
10 Catalyst::Engine::HTTP::Daemon - Catalyst HTTP Daemon Engine
14 A script using the Catalyst::Engine::HTTP::Daemon module might look like:
18 BEGIN { $ENV{CATALYST_ENGINE} = 'HTTP::Daemon' }
21 use lib '/path/to/MyApp/lib';
28 This is the Catalyst engine specialized for development and testing.
30 =head1 OVERLOADED METHODS
32 This class overloads some methods from C<Catalyst::Engine::HTTP::Base>.
41 my ( $class, $request, $response, $client ) = @_;
43 $request->uri->scheme('http'); # Force URI::http
44 $request->uri->host( $request->header('Host') || $client->sockhost );
45 $request->uri->port( $client->sockport );
47 my $http = Catalyst::Engine::HTTP::Base::struct->new(
48 address => $client->peerhost,
53 $class->SUPER::handler($http);
62 my $port = shift || 3000;
64 $SIG{'PIPE'} = 'IGNORE';
66 my $daemon = Catalyst::Engine::HTTP::Daemon::Catalyst->new(
73 unless ( defined $daemon ) {
74 die(qq/Failed to create daemon. Reason: '$!'/);
77 my $base = URI->new( $daemon->url )->canonical;
79 printf( "You can connect to your server at %s\n", $base );
81 my $select = IO::Select->new($daemon);
85 for my $client ( $select->can_read(0.01) ) {
87 if ( $client == $daemon ) {
88 $client = $daemon->accept;
89 $client->timestamp = time;
91 $select->add($client);
95 next if $client->request;
96 next if $client->response;
98 my $nread = $client->sysread( my $buf, 4096 );
100 unless ( defined($nread) && length($buf) ) {
102 $select->remove($client);
108 $client->request_buffer .= $buf;
110 if ( my $request = $client->get_request ) {
111 $client->request = $request;
112 $client->timestamp = time
117 for my $client ( $select->handles ) {
119 next if $client == $daemon;
121 if ( ( time - $client->timestamp ) > 60 ) {
123 $select->remove($client);
129 next if $client->response;
130 next unless $client->request;
132 $client->response = HTTP::Response->new;
133 $client->response->protocol( $client->request->protocol );
135 $class->handler( $client->request, $client->response, $client );
138 for my $client ( $select->can_write(0.01) ) {
140 next unless $client->response;
142 unless ( $client->response_buffer ) {
143 $client->response_buffer = $client->response->as_string;
144 $client->response_offset = 0;
147 my $nwrite = $client->syswrite( $client->response_buffer,
148 $client->response_length,
149 $client->response_offset );
151 unless ( defined($nwrite) ) {
153 $select->remove($client);
159 $client->response_offset += $nwrite;
161 if ( $client->response_offset == $client->response_length ) {
163 my $connection = $client->request->header('Connection');
165 unless ( $connection && $connection =~ /Keep-Alive/i ) {
166 $select->remove($client);
170 $client->response = undef;
171 $client->request = undef;
172 $client->response_buffer = undef;
182 L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::HTTP::Base>,
187 Sebastian Riedel, C<sri@cpan.org>
188 Christian Hansen, C<ch@ngmedia.com>
192 This program is free software, you can redistribute it and/or modify it under
193 the same terms as Perl itself.
197 package Catalyst::Engine::HTTP::Daemon::Catalyst;
200 use base 'HTTP::Daemon';
203 return shift->SUPER::accept('Catalyst::Engine::HTTP::Daemon::Client');
207 return "Catalyst/$Catalyst::VERSION";
210 package Catalyst::Engine::HTTP::Daemon::Client;
213 use base 'HTTP::Daemon::ClientConn';
215 sub request : lvalue {
217 ${*$self}{'request'};
220 sub request_buffer : lvalue {
222 ${*$self}{'httpd_rbuf'};
225 sub response : lvalue {
227 ${*$self}{'response'};
230 sub response_buffer : lvalue {
232 ${*$self}{'httpd_wbuf'};
235 sub response_length {
237 return length( $self->response_buffer );
240 sub response_offset : lvalue {
242 ${*$self}{'httpd_woffset'};
245 sub timestamp : lvalue {
247 ${*$self}{'timestamp'};