#!/usr/local/bin/perl 

use lib "/etc/lighttpd/lib/perl/";
use strict; 
use HTML::Mason::CGIHandler; 
use FCGI; 
use FCGI::ProcManager;
use CGI::Carp;
use Data::Dumper;
use Getopt::Long;
use POSIX;

umask 002;

{
 package HTML::Mason::Commands;
 	use Data::Dumper;
 	use CGI;
	use CGI::Carp;

	use vars qw/%globals %lits $conn/;
	}

my ($proc_manager, $socket, $listen, $pidfile, %h, %e);
my $nprocs = 2;

GetOptions(
	'listen|l=s'	=> \$listen,
	'nprocs|n=i'	=> \$nprocs,
	'pidfile|p=s'	=> \$pidfile,
	);

if ($listen){
	$socket = FCGI::OpenSocket($listen, 100);
	}

%ENV = ();
my $stderr = \*STDERR;

my $request = FCGI::Request(
		\*STDIN,
		\*STDOUT,
		\*STDERR,
		\%ENV,
		$socket,
		&FCGI::FAIL_ACCEPT_ON_INTR
		);

if ($listen){
	fork && exit;

	my $proc_manager = FCGI::ProcManager->new({ 
		n_processes => $nprocs,
		pid_fname   => $pidfile });

	open STDIN, "+</dev/null" || die $!;
	open STDOUT, ">&STDIN" || die $!;
	open STDERR, ">&STDIN" || die $!;

	$proc_manager->pm_manage();
	}

while ($request->Accept >= 0){
	$proc_manager && $proc_manager->pm_pre_dispatch;
	my @comp_roots;

	# We could do this instead of the virtual hosting
	# my ($comp_root) = $ENV{DOCUMENT_ROOT} . $ENV{HTTP_HOST};
	# But instead we serveralias and just live with the root
	my ($comp_root) = $ENV{DOCUMENT_ROOT};

	my $data_root = "/etc/lighttpd/HTML-Mason/data/";
	if ($comp_root =~ m#([^/]+)/?$#){
		$data_root .= $1;
		}

	my $uri = $ENV{REQUEST_URI};
	if ($uri =~ /^([^\?]*)(?:\?(.*))?/){
		$ENV{PATH_INFO} = $1;
		}

	# FakeApache will put SCRIPT_NAME and PATH_INFO together for uri
	$ENV{SCRIPT_NAME} = '';

	$ENV{PATH_INFO} .= 'index.html' if ($ENV{PATH_INFO} =~ m#/$#);

	unshift @comp_roots, ['web' => $comp_root];

	my $handler = HTML::Mason::CGIHandler->new(
		comp_root	=> \@comp_roots,
		data_dir 	=> $data_root,
		error_format => 'html',
		);

	%HTML::Mason::Commands::globals = ();
	$ENV{QUERY_CHARSET} = '';

	eval { $handler->handle_request };
	if (my $raw_error = $@) {
		# print out a pretty system error page and log $raw_error
		print $raw_error;
		exit;
		}

	$proc_manager && $proc_manager->pm_post_dispatch;
	}

exit 0;

