examples/daemon.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use CGI;
   7 use HTTP::Daemon;
   8 use HTTP::Request;
   9 use HTTP::Request::AsCGI;
  10 use HTTP::Response;
  11
  12 $SIG{'PIPE'} = 'IGNORE';
  13
  14 my $server = HTTP::Daemon->new( LocalPort => 3000, ReuseAddr => 1 ) || die;
  15
  16 print "Please contact me at: <URL:", $server->url, ">\n";
  17
  18 while ( my $client = $server->accept ) {
  19
  20     my %e = (
  21         REMOTE_ADDR => $client->peerhost,
  22         REMOTE_HOST => $client->peerhost,
  23         REMOTE_PORT => $client->peerport
  24     );
  25
  26     while ( my $request = $client->get_request ) {
  27
  28         CGI::initialize_globals();
  29
  30         $request->uri->scheme('http');
  31         $request->uri->host_port( $request->header('Host') || URI->new($server)->host_port );
  32
  33         my $c = HTTP::Request::AsCGI->new( $request, %e )->setup;
  34         my $q = CGI->new;
  35
  36         print $q->header,
  37               $q->start_html('Hello World'),
  38               $q->h1('Hello World'),
  39               $q->end_html;
  40
  41         $c->restore;
  42
  43         my $response = $c->response;
  44
  45         # to prevent blocking problems in single threaded daemon.
  46         $response->header( Connection => 'close' );
  47
  48         $client->send_response($response);
  49     }
  50
  51     $client->close;
  52 }