fixed some minor bugs
[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 $lwp = Catalyst::Engine::Test::LWP->new(
72                 address  => $connection->peerhost,
73                 hostname => gethostbyaddr( $connection->peeraddr, AF_INET ),
74                 request  => $request,
75                 response => HTTP::Response->new
76             );
77
78             $class->handler($lwp);
79             $connection->send_response( $lwp->response );
80
81         }
82
83         $connection->close;
84         undef($connection);
85     }
86 }
87
88 =back
89
90 =head1 SEE ALSO
91
92 L<Catalyst>, L<HTTP::Daemon>.
93
94 =head1 AUTHOR
95
96 Sebastian Riedel, C<sri@cpan.org>
97 Christian Hansen, C<ch@ngmedia.com>
98
99 =head1 COPYRIGHT
100
101 This program is free software, you can redistribute it and/or modify it under
102 the same terms as Perl itself.
103
104 =cut
105
106 package Catalyst::Engine::HTTP::Catalyst;
107
108 use strict;
109 use base 'HTTP::Daemon';
110
111 sub product_tokens {
112     "Catalyst/$Catalyst::VERSION";
113 }
114
115 1;