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( -charset => 'UTF-8' ),
  37               $q->start_html(
  38                   -title    => 'Hello World',
  39                   -encoding => 'UTF-8'
  40               ),
  41               $q->h1('Hello World'),
  42               $q->start_form,
  43               $q->table(
  44                   $q->Tr( [
  45                       $q->td( [ 'Name',  $q->textfield( -name => 'name'  ) ] ),
  46                       $q->td( [ 'Email', $q->textfield( -name => 'email' ) ] ),
  47                       $q->td( [ 'Phone', $q->textfield( -name => 'phone' ) ] ),
  48                       $q->td( [ 'File',  $q->filefield( -name => 'file'  ) ] )
  49                   ] )
  50               ),
  51               $q->submit,
  52               $q->end_form,
  53               $q->h2('Params'),
  54               $q->Dump,
  55               $q->end_html;
  56
  57         my $response = $c->restore->response;
  58
  59         # tell client to close socket to prevent blocking problems
  60         # in this single threaded daemon.
  61         $response->header( Connection => 'close' );
  62
  63         $client->send_response($response);
  64     }
  65
  66     $client->close;
  67 }