lib/Catalyst/Engine/HTTP/Daemon.pm

   1 package Catalyst::Engine::HTTP::Daemon;
   2
   3 use strict;
   4 use base 'Catalyst::Engine::HTTP::Base';
   5
   6 use IO::Socket qw( SOCK_STREAM SOMAXCONN );
   7
   8 =head1 NAME
   9
  10 Catalyst::Engine::HTTP::Daemon - Catalyst HTTP Daemon Engine
  11
  12 =head1 SYNOPSIS
  13
  14 A script using the Catalyst::Engine::HTTP::Daemon module might look like:
  15
  16     #!/usr/bin/perl -w
  17
  18     BEGIN {  $ENV{CATALYST_ENGINE} = 'HTTP::Daemon' }
  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::HTTP::Base>.
  33
  34 =over 4
  35
  36 =item $c->handler
  37
  38 =cut
  39
  40 sub handler {
  41     my ( $class, $client ) = @_;
  42
  43     $client->timeout(5);
  44
  45     while ( my $request = $client->get_request ) {
  46
  47         $request->uri->scheme('http');    # Force URI::http
  48         $request->uri->host( $request->header('Host') || $client->sockhost );
  49         $request->uri->port( $client->sockport );
  50
  51         my $http = Catalyst::Engine::HTTP::Base::struct->new(
  52             address  => $client->peerhost,
  53             request  => $request,
  54             response => HTTP::Response->new
  55         );
  56
  57         $class->SUPER::handler($http);
  58
  59         $client->send_response( $http->response );
  60     }
  61
  62     $client->close;
  63 }
  64
  65 =item $c->run
  66
  67 =cut
  68
  69 sub run {
  70     my $class = shift;
  71     my $port  = shift || 3000;
  72
  73     $SIG{'PIPE'} = 'IGNORE';
  74
  75     $HTTP::Daemon::PROTO = 'HTTP/1.0'; # For now until we resolve the blocking
  76                                        # issues with HTTP 1.1
  77
  78     my $daemon = Catalyst::Engine::HTTP::Daemon::Catalyst->new(
  79         Listen    => SOMAXCONN,
  80         LocalPort => $port,
  81         ReuseAddr => 1,
  82         Type      => SOCK_STREAM,
  83     );
  84
  85     unless ( defined $daemon ) {
  86         die( qq/Failed to create daemon. Reason: '$!'/ );
  87     }
  88
  89     my $base = URI->new( $daemon->url )->canonical;
  90
  91     printf( "You can connect to your server at %s\n", $base );
  92
  93     while ( my $client = $daemon->accept ) {
  94         $class->handler($client);
  95     }
  96 }
  97
  98 =back
  99
 100 =head1 SEE ALSO
 101
 102 L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::HTTP::Base>,
 103 L<HTTP::Daemon>.
 104
 105 =head1 AUTHOR
 106
 107 Sebastian Riedel, C<sri@cpan.org>
 108 Christian Hansen, C<ch@ngmedia.com>
 109
 110 =head1 COPYRIGHT
 111
 112 This program is free software, you can redistribute it and/or modify it under
 113 the same terms as Perl itself.
 114
 115 =cut
 116
 117 package Catalyst::Engine::HTTP::Daemon::Catalyst;
 118
 119 use strict;
 120 use base 'HTTP::Daemon';
 121
 122 sub product_tokens {
 123     "Catalyst/$Catalyst::VERSION";
 124 }
 125
 126 1;