Applied HTTP.pm patch from Andy Grundman <andy@hybridized.org>. Fixed debug log on...
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Engine / HTTP.pm
1 package Catalyst::Engine::HTTP;
2
3 use strict;
4 use base 'Catalyst::Engine::Test';
5
6 use IO::Socket qw(AF_INET INADDR_ANY SOCK_STREAM SOMAXCONN);
7
8 =head1 NAME
9
10 Catalyst::Engine::HTTP - Catalyst HTTP Engine
11
12 =head1 SYNOPSIS
13
14 A script using the Catalyst::Engine::HTTP module might look like:
15
16     #!/usr/bin/perl -w
17
18     BEGIN {  $ENV{CATALYST_ENGINE} = 'HTTP' }
19
20     use strict;
21     use lib '/path/to/MyApp/lib';
22     use MyApp;
23
24     MyApp->run;
25
26 =head1 DESCRIPTION
27
28 This is the Catalyst engine specialized for development and testing.
29
30 =head1 OVERLOADED METHODS
31
32 This class overloads some methods from C<Catalyst::Engine::Test>.
33
34 =over 4
35
36 =item $c->run
37
38 =cut
39
40 $SIG{'PIPE'} = 'IGNORE';
41
42 sub run {
43     my $class = shift;
44     my $port  = shift || 3000;
45
46     my $daemon = Catalyst::Engine::HTTP::Catalyst->new(
47         Listen    => SOMAXCONN,
48         LocalPort => $port,
49         ReuseAddr => 1,
50         Type      => SOCK_STREAM,
51     );
52
53     unless ($daemon) {
54         die("Failed to create daemon: $!\n");
55     }
56
57     my $base = URI->new( $daemon->url )->canonical;
58
59     printf( "You can connect to your server at %s\n", $base );
60
61     while ( my $connection = $daemon->accept ) {
62
63         $connection->timeout(5);
64
65         while ( my $request = $connection->get_request ) {
66
67             $request->uri->scheme('http');    # Force URI::http
68             $request->uri->host( $request->header('Host') || $base->host );
69             $request->uri->port( $base->port );
70             
71             my $hostname = gethostbyaddr( $connection->peeraddr, AF_INET );
72
73             my $http = Catalyst::Engine::Test::HTTP->new(
74                 address  => $connection->peerhost,
75                 hostname => $hostname || $connection->peerhost,
76                 request  => $request,
77                 response => HTTP::Response->new
78             );
79
80             $class->handler($http);
81             $connection->send_response( $http->response );
82
83         }
84
85         $connection->close;
86         undef($connection);
87     }
88 }
89
90 =back
91
92 =head1 SEE ALSO
93
94 L<Catalyst>, L<HTTP::Daemon>.
95
96 =head1 AUTHOR
97
98 Sebastian Riedel, C<sri@cpan.org>
99 Christian Hansen, C<ch@ngmedia.com>
100
101 =head1 COPYRIGHT
102
103 This program is free software, you can redistribute it and/or modify it under
104 the same terms as Perl itself.
105
106 =cut
107
108 package Catalyst::Engine::HTTP::Catalyst;
109
110 use strict;
111 use base 'HTTP::Daemon';
112
113 sub product_tokens {
114     "Catalyst/$Catalyst::VERSION";
115 }
116
117 1;