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         my $c = HTTP::Request::AsCGI->new( $request, %e )->setup;
  29         my $q = CGI->new;
  30
  31         print $q->header,
  32               $q->start_html('Hello World'),
  33               $q->h1('Hello World'),
  34               $q->end_html;
  35
  36         $c->restore;
  37
  38         my $message = "HTTP/1.1 200\x0d\x0a";
  39
  40         while ( my $line = $c->stdout->getline ) {
  41             $message .= $line;
  42             last if $line =~ /^\x0d?\x0a$/;
  43         }
  44
  45         my $response = HTTP::Response->parse($message);
  46
  47         if ( my $code = $response->header('Status') ) {
  48             $response->code($code);
  49         }
  50
  51         $response->header( Connection => 'close' );
  52         $response->protocol( $request->protocol );
  53         $response->content( sub {
  54             if ( $c->stdout->read( my $buffer, 4096 ) ) {
  55                 return $buffer;
  56             }
  57             return undef;
  58         });
  59
  60         $client->send_response($response);
  61         $client->close;
  62     }
  63
  64     #$client->close;
  65 }