lib/Catalyst/Engine/HTTP/Daemon.pm

   1 package Catalyst::Engine::HTTP::Daemon;
   2
   3 use strict;
   4 use base 'Catalyst::Engine::Test';
   5
   6 use IO::Socket qw(AF_INET);
   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 {
  19        $ENV{CATALYST_ENGINE} = 'HTTP::Daemon';
  20     }
  21
  22     use strict;
  23     use lib '/path/to/MyApp/lib';
  24     use MyApp;
  25
  26     MyApp->run;
  27
  28 =head1 DESCRIPTION
  29
  30 This is the Catalyst engine specialized for development and testing.
  31
  32 =head1 OVERLOADED METHODS
  33
  34 This class overloads some methods from C<Catalyst::Engine::Test>.
  35
  36 =over 4
  37
  38 =item $c->run
  39
  40 =cut
  41
  42 $SIG{'PIPE'} = 'IGNORE';
  43
  44 sub run {
  45     my $class = shift;
  46     my $port  = shift || 3000;
  47
  48     my $daemon = Catalyst::Engine::HTTP::Daemon::Catalyst->new(
  49         LocalPort => $port,
  50         ReuseAddr => 1
  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         while ( my $request = $connection->get_request ) {
  64
  65             $request->uri->scheme('http');    # Force URI::http
  66             $request->uri->host( $base->host );
  67
  68             my $lwp = Catalyst::Engine::Test::LWP->new(
  69                 request  => $request,
  70                 address  => $connection->peerhost,
  71                 hostname => gethostbyaddr( $connection->peeraddr, AF_INET )
  72             );
  73
  74             $class->handler($lwp);
  75             $connection->send_response( $lwp->response );
  76         }
  77
  78         $connection->close;
  79         undef($connection);
  80     }
  81 }
  82
  83 =back
  84
  85 =head1 SEE ALSO
  86
  87 L<Catalyst>, L<HTTP::Daemon>.
  88
  89 =head1 AUTHOR
  90
  91 Sebastian Riedel, C<sri@cpan.org>
  92 Christian Hansen, C<ch@ngmedia.com>
  93
  94 =head1 COPYRIGHT
  95
  96 This program is free software, you can redistribute it and/or modify it under
  97 the same terms as Perl itself.
  98
  99 =cut
 100
 101 package Catalyst::Engine::HTTP::Daemon::Catalyst;
 102
 103 use strict;
 104 use base 'HTTP::Daemon';
 105
 106 sub product_tokens {
 107     "Catalyst/$Catalyst::VERSION";
 108 }
 109
 110 1;