The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#===============================================================================
#
#         FILE: wd_fcgi.fpl
#
#  DESCRIPTION:  FastCGI script for WebDAO project
#       AUTHOR:  Aliaksandr P. Zahatski (Mn), <zag@cpan.org>
#===============================================================================
#$Id: wd_fcgi.fpl,v 1.1 2006/10/13 12:39:09 zag Exp $
use WebDAO;
use FCGI;
use WebDAO::CVfcgi;
use WebDAO::Session;
use WebDAO::Lex;
use WebDAO::FCGI::ProcManager;
use WebDAO::Util;
use Data::Dumper;
use Getopt::Long;
use Pod::Usage;
use strict;
use warnings;
use POSIX;

use Carp;

my ( $listen, $nproc, $pidfile, $manager, $detach, $man, $help, $maxreq );

#set defaults
$nproc = 1;
my %opt = ( 'help|?' => \$help, man => \$man, );
GetOptions(
    'help|?'      => \$help,
    'listen|l=s'  => \$listen,
    'nproc|n=i'   => \$nproc,
    'pidfile|p=s' => \$pidfile,
    'daemon|d'    => \$detach,
    'maxreq|m=i'  => \$maxreq,
    'man'         => \$man
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage( -exitstatus => 0, -verbose => 2 ) if $man;

#begin init socket
my $sock = 0;
if ($listen) {
    my $saved_umask = umask(0);
    $sock = FCGI::OpenSocket( $listen, 100 )
     or die "failed to open FastCGI socket: $!";
    umask($saved_umask);
}
elsif ( $^O ne 'MSWin32' ) {
    -S STDIN
      or die "STDIN is not a socket; specify a listen location";
}

#fix FCGI output update after FCGI::VERSION 0.68
# https://rt.cpan.org/Public/Bug/Display.html?id=52400
my $fcgi_controller = 'WebDAO::CVfcgi';
if ( $FCGI::VERSION <= 0.68 ) {
    #die "Update FCGI to > 0.68 !";
    $fcgi_controller = 'WebDAO::CVfcgiold'
}
my $proc_manager;
if ($listen) {
    &daemon_fork() if $detach;
    $proc_manager = new WebDAO::FCGI::ProcManager::(
        {
            n_processes => $nproc,
            pid_fname   => $pidfile,
        }
    );

    # detach *before* the ProcManager inits
    &daemon_detach() if $detach;
    $proc_manager->pm_manage();
}

=head2 daemon_fork

Performs the first part of daemon initialisation.  Specifically,
forking.  STDERR, etc are still connected to a terminal.

=cut

sub daemon_fork {

    fork && exit;
}

=head2 daemon_detach

Performs the second part of daemon initialisation.  Specifically,
disassociates from the terminal.

However, this does B<not> change the current working directory to "/",
as normal daemons do.  It also does not close all open file
descriptors (except STDIN, STDOUT and STDERR, which are re-opened from
F</dev/null>).

=cut

sub daemon_detach {
    print "FastCGI daemon started (pid $$)\n";
    open STDIN,  "+</dev/null" or die $!;
    open STDOUT, ">&STDIN"     or die $!;
    open STDERR, ">&STDIN"     or die $!;
    POSIX::setsid();
}
    #preload defaults
    WebDAO::Util::get_classes(__env => \%ENV, __preload=>1);


my $count_req = $maxreq || $ENV{wdFCGIreq} || -1;
my $request = FCGI::Request(
  \*STDIN, \*STDOUT, \*STDERR, \%ENV, $sock, 1
  );

while ( $count_req != 0 and ($request->Accept() >= 0) ) {

    $proc_manager && $proc_manager->pm_pre_dispatch();

    if ( $ENV{SERVER_SOFTWARE} && $ENV{SERVER_SOFTWARE} =~ /lighttpd/ ) {
        $ENV{PATH_INFO} ||= delete $ENV{SCRIPT_NAME};
    }

    my $ini = WebDAO::Util::get_classes(__env => \%ENV, __preload=>1);

    my $store_obj = "$ini->{wdStore}"->new(
            %{ $ini->{wdStorePar} }
    );

    my $cv = $fcgi_controller->new(env=>\%ENV);

    my $sess = "$ini->{wdSession}"->new(
        %{ $ini->{wdSessionPar} },
        store => $store_obj,
        cv    => $cv,
    );

    #determine root document
    my $env_var = $ENV{wdIndexFile} || $ENV{WD_INDEXFILE};
    my %ini_pars = ();
    if ( $env_var && $env_var ne '-' && !-z $env_var ) {
        my ($filename) = grep { -r $_ && -f $_ } $env_var,
          "$ENV{DOCUMENT_ROOT}/$env_var", "$ENV{DOCUMENT_ROOT}/index.xhtml";
        die "$0 ERR:: file not found or can't access (WD_INDEXFILE): $env_var"
          unless $filename;

        open FH, "<$filename" or die $!;
        my $content ='';
        { local $/=undef;
        $content = <FH>;
        }
        close FH;
        my $lex = new WebDAO::Lex:: tmpl => $content;
        $ini_pars{lex} = $lex;
    }
    else {
        $ini_pars{source} = '';
    }
     my $eng = "$ini->{wdEngine}"->new(
        %{ $ini->{wdEnginePar} },
        %ini_pars,
        session => $sess,
    );

    $sess->ExecEngine($eng);
    $sess->destroy;
    --$count_req if $count_req > 0;
    $proc_manager && $proc_manager->pm_post_dispatch();
}
FCGI::finish();

__END__

=head1 NAME

wd_fcgi.fpl - FastCGI script for WebDAO project

=head1 SYNOPSIS

wd_fcgi.fpl [options]

    -d -daemon     Daemonize the server.
    -p -pidfile    Write a pidfile with the pid of the process manager.
    -l -listen     Listen on a socket path, hostname:port, or :port.
    -n -nproc      The number of processes started to handle requests.
    -m -maxreq     Number of request before process will be restarted 
                   -1 - unlimited. (defailt: -1)
                   

=head1 SETUP



=head1 SEE ALSO

http://sourceforge.net/projects/webdao, WebDAO

=head1 AUTHOR

Zahatski Aliaksandr, E<lt>zag@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2003-2012 by Zahatski Aliaksandr

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut