#!/usr/bin/perl 
use FCGI;
use FCGI::ProcManager;
use Getopt::Long;
use POSIX qw(setsid :signal_h);
use CGI;
use strict;

our $socket;

my ($name,$lib,$module,$nproc,$sock,$pidfile,$daemon,$run);
$nproc=2;
$run  ='run';

my $result = GetOptions (
    'name=s'    => \$name,
    'lib=s'     => \$lib,
    'module=s'  => \$module,
    'handler=s' => \$run,
    'nproc=i'   => \$nproc,
    'socket=s'  => \$sock,
    'pidfile=s' => \$pidfile,
    'daemon'    => \$daemon);
die(
"$0 
# required
    --name=$name 
    --module=$module 
    --socket=$sock 
# optional
    --lib=$lib 
    --handler=$run 
    --nproc=$nproc
    --pidfile=$pidfile 
    --daemon=$daemon 
]") unless $name && $module && $sock;

# patch FCGI::ProcManager to not mangle process names
sub FCGI::ProcManager::managing_init {
    my ($this) = @_;
    unless ($this->no_signals()) {
        sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or
	        $this->pm_warn("sigaction: SIGTERM: $!");
        sigaction(SIGHUP,  $this->{sigaction_no_sa_restart}) or
	        $this->pm_warn("sigaction: SIGHUP: $!");
        $FCGI::ProcManager::SIG_CODEREF = sub { $this->sig_manager(@_) };
    }
    $this->pm_write_pid_file();
}

sub daemonize {
    chdir '/' or die "Can't chdir to /: $!";
    defined( my $pid = fork ) or die "Can't fork: $!";
    exit if $pid;
    setsid() or die "Can't start a new session: $!";
    umask 0;
}

sub main {
    push @INC,$lib;
    eval "require $module";
    die  "Require: $@" if $@;
    $0 = "fcgi-$name-manager";
    my $proc_manager = FCGI::ProcManager->new( {n_processes => $nproc, pid_fname => $pidfile } );
    $socket = FCGI::OpenSocket( $sock, 250 );   # 250 requests queue
    my $request= FCGI::Request( \*STDIN, \*STDOUT, \*STDERR, \%ENV, $socket, &FCGI::FAIL_ACCEPT_ON_INTR );
    $proc_manager->pm_manage();
    request_loop($proc_manager,$request) if $request;
    FCGI::CloseSocket($socket);
}

sub request_loop {
    my ($pm,$req) = @_;
    $0 = "fcgi-$name";
    my $obj = eval "new $module";
    die "New $module: $@" 
        if $@;
    while ( $req->Accept() >=0 ) {
        CGI::_reset_globals; 
        $obj->{__QUERY_OBJ} = new CGI;
        $obj->$run();
    }
}

daemonize() if $daemon;
main();

