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 my $server = HTTP::Daemon->new || die;
  13
  14 print "Please contact me at: <URL:", $server->url, ">\n";
  15
  16 while ( my $client = $server->accept ) {
  17
  18     while ( my $request = $client->get_request ) {
  19
  20         my $c = HTTP::Request::AsCGI->new($request)->setup;
  21         my $q = CGI->new;
  22
  23         print $q->header,
  24               $q->start_html('Hello World'),
  25               $q->h1('Hello World'),
  26               $q->end_html;
  27
  28         $c->restore;
  29
  30         my $message = "HTTP/1.1 200 OK\x0d\x0a";
  31
  32         while ( my $line = $c->stdout->getline ) {
  33             $message .= $line;
  34             last if $line =~ /^\x0d?\x0a$/;
  35         }
  36
  37         my $response = HTTP::Response->parse($message);
  38         $response->content( sub {
  39             if ( $c->stdout->read( my $buffer, 4096 ) ) {
  40                 return $buffer;
  41             }
  42             return undef;
  43         });
  44
  45         $client->send_response($response);
  46     }
  47
  48     $client->close;
  49 }