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