#!/usr/bin/perl
use strict;
use warnings FATAL => 'all';
use Net::HTTPServer;

my $httpd = Net::HTTPServer->new(
	'port'     => 8081,
	'docroot'  => 'htdocs',
	'index'    => ['index.html', 'index.pl', 'index.cgi'],
	'log'      => 'STDOUT',
	'type'     => 'forking',
	'type'     => 'single',
	'numproc'  => 5
);

use CGI qw(-compile -oldstyle_urls);
use YourCGIApplicationModule;

sub yourapp {
	my $req = shift;
	my $res = $req->Response;

	$ENV{$_} = $req->Env($_) || '' foreach (keys(%{$req->Env()}));
	$ENV{HTTP_COOKIE} = join ('; ', map { $_ . '=' . $req->Cookie($_) }
		keys %{$req->Cookie()});

	my $your_cgi_app = YourCGIApplicationModule->new({
		QUERY => CGI->new(
			($req->Method eq 'GET') ?
				$req->Query : ($req->Request =~ /\n\W*\n([^\n]+)/) ? $1 : ''
		)
	});

	$res->CaptureSTDOUT;
	$your_cgi_app->run;
	$res->ProcessSTDOUT({ strip_header => 0 });

	my ($headers, @content) = split(/\n\n/, $res->Body);
	my $code = 200;
	foreach (split(/\n/, $headers)) {
		if (/^(.*?): (.*)$/) {
			$res->Header($1, $2);
			$code = $1 if (($1 eq 'Status') and ($2 =~ /^(\d+)\s/));
		}
	}
	$res->Code($code);
	$res->Body( join("\n\n", @content) );

	return $res;
}

$httpd->RegisterURL({
	'/yourapp' => \&yourapp
});

$httpd->Start;
$httpd->Process;
$httpd->Stop;

exit 0;