#!/usr/local/bin/perl
use strict;
use warnings;

=head1 NAME
site-mason_handler.fcgi - run Mason on shared host as FastCGI

=head1 COPYRIGHT & LICENSE
Copyright 2006-2010 Joe Pepersack (joe@pepersack.net)

This program is free software; you may use it under the terms of the 
Creative Commons Attribution-Share Alike 3.0 United States License

=head1 SYNOPSIS
FastCGI handler script to use Mason on a shared hosting provider, such as 
Dreamhost.  It is assumed that this script will reside in $docroot/cgi-bin/  
If you are running multiple Mason sites under the same username, it is useful 
to give each handler a distinct name so that you can use ps or top to determine 
which process belongs to which site

Some additional configuration is needed in .htaccess in order to use this.  
At a minimum you need something like:

    AddHandler fastcgi-script .fcgi
    <FilesMatch "\.(html)$"> 
        Action html-mason /cgi-bin/site-masonhandler.fcgi 
        SetHandler html-mason 
    </FilesMatch>

The following is highly recommended as well:

    <FilesMatch "(\.htaccess|\.mas|handler|\.cfg|\.dat|\.readme)$"> 
        Order allow,deny 
        Deny from all 
    </FilesMatch>

Note while this is geared towards using FastCGI it will work just fine
under regular CGI.   Just change the AddHandler line in .htacces to:

    AddHandler cgi-script .fcgi

This is highly useful when you are debugging, because under FastCGI, some
errors will cause the browser to hang for 60 seconds until the session
times out.   Using CGI avoids this; revert to fastcgi when your bugs are
squashed.

Unfortunatly, dhandler processing is borked on dreamhost - requests for 
non-existant files get 404'ed before the mason handler ever fires.  This means 
we can't simply use $mason->handle_cgi_object($cgi);    To work around this, 
we can use mod_rewrite to send any request for anything that is not a file 
and not a directory to a dummy page.  

If you want dhandlers to work, the following is required in .htaccess:

    RewriteEngine On
    RewriteCond %{REQUEST_FILENAME} !-f
    RewriteCond %{REQUEST_FILENAME} !-d
    RewriteRule . /dummy.html [L]
    
Because this workaround breaks DirectoryIndex handling (which works correctly
otherwise), the root dhandler should be something like:

    <%perl>
    my $page = $r->path_info;
    $page .= 'index.html' if $page =~ /\/$/; 
    if ( $m->comp_exists($page) ) { $m->redirect($page); }
    else { $m->redirect('/error/404.html'); }
    </%perl>

This can be overridden in any subdirectory by giving it a 'real' dhandler
You could use $m->comp instead of $m->redirect for index pages, but this 
breaks down if you have methods defined in your autohandler that you want
to override in the target component.  If you used $m->comp,  the autohandler 
would inherit it's methods from the dhandler instead of the target component.

As of mid-2008, Dreamhost has Mason pre-installed, at least on my host 
(Eastman), as well as many other CPAN modules.  If you use any 'unsupported' 
cpan modules or a custom module (EG catalyst), you will have to add your 
module directory to @INC yourself.  YMMV if you're on a different server.  
If you're on a private server, you should probably be using mod_perl instead
of FastCGI anyway.

=head1 SEE ALSO
The documentation for CGI::Fast and HTML::Mason

=cut

# --------------------------------------------------------------------------- #

#### CHANGE THIS FOR YOUR SITE ####
my $home = '/home/yourname';    # ~ on your Dreamhost account
my $site = 'yoursite.tld';      # the name of your site

# any changes beyond this point are optional
my $mason_root = "$home/$site/";               # (usually docroot)
my $mason_data = "$home/.masondata-$site/";    # (should not be under docroot)
my $logfile    = "$home/mason-${site}.log";    # name of custom log or undef

# if $logfile = undef, log messages will go to the apache errorlog

# flags for optional features
my $verbosity = 1;    # enable custom logging level 0 - N
my $usedb     = 0;    # create and use global db handle

# module dependencies
use CGI::Fast qw| :standard -compile :all -tabindex -utf8 |;
use CGI::Carp;
use HTML::Mason;
use HTML::Mason::CGIHandler;
use Time::HiRes qw| time gettimeofday |;
use POSIX qw| strftime |;
use DBI;

# add any additional CPAN or custom modules your app requires here
# use My::Module;

# turn logging on if so configured
if ( $verbosity > 0 && defined($logfile) ) {
    open LOG, '>>', $logfile;
    LOG->autoflush(1);
}
logmsg( 'Starting FastCGI session', 0 );

# globals variables to share with mason
# using $::VAR is safe under FastCGI; mod_perl, not so much
$::DBH = init_db();                   # persistent database handle
$::STATS = { init_time => now() };    # time this session started

# variables defined under the mason_globals config option are global to Mason
# but are not shared between Mason and the CGI wrapper
# the values would likely be set in a <%once> section in a syshandler object.
#my ($var);
#$::MASON_GLOBALS = [ qw( $var ) ];
$::MASON_GLOBALS = [];
my $mason = init_mason();    # Persistent HTML::Mason::CGIHandler object

# This runs once per request.
# CGI::Fast->new blocks until a # request comes in.
# If Apache sees that all existing handlers are still working when a new
# request comes in, it will spawn a new handler process.
while ( my $cgi = CGI::Fast->new ) {
    my $start = time();
    charset('utf-8');

    # The dhandler workaround hack sets $ENV{PATH_INFO} to /dummy.html
    # if the user requests anything nonexistent, so we need to restore
    # the "real" value, which is in $ENV{REQUEST_URI}
    my $real_uri = $ENV{REQUEST_URI};
    ++$::STATS->{hits};
    ++$::STATS->{views}{$real_uri};
    logmsg( "Processing request $real_uri", 3 );

    if ( $real_uri eq '/dummy.html' ) {

        # if someone actually requested the dummy, give them an error
        $ENV{PATH_INFO} = '/error/404.html';    # be sure this exists!!!
    }
    else {

        # otherwise, revert to what was actually requested
        $ENV{PATH_INFO} = $real_uri;
    }

    # and pass the buck to mason
    $mason->handle_request();

    # finally, spit out some benchmarking data;
    my $ms = elapsed_time($start);
    $::STATS->{totaltime} += $ms;
    logmsg( sprintf( '%6.2f ms %s', $ms, $real_uri ), 1 );
}

END {

    # Since mod_fastcgi manages processes via signals, this will never get
    # run if we're runing under the fastcgi-script handler. Therefore,
    # if we absolutely, positively need to run some cleanup code before
    # exiting, we need to use signal handling to catch PIPE, TERM, and USR1.
    # See: http://www.fastcgi.com/docs/faq.html for more info
    logmsg( 'Shutting down', 0 );
    $::DBH->disconnect if $usedb;
    close LOG;
}

# --------------------------------------------------------------------------- #
sub init_mason {

    # initialize the mason object
    my $h;
    eval {
        logmsg( 'Initializing Mason CGIHandler', 2 );
        $h = HTML::Mason::CGIHandler->new(
            comp_root            => $mason_root,
            data_dir             => $mason_data,
            allow_globals        => $::MASON_GLOBALS,
            error_mode           => "output",
            default_escape_flags => "h"
        );
    } or do {
        croak "Could not create mason cgihandler: $@";
    };
    return $h;
}

# --------------------------------------------------------------------------- #
sub init_db {

    # create database handle
    return undef unless $usedb;    # bail if db disabled
    logmsg( 'initializing db handle', 2 );

    # read db config from file.  This is a single line, pipe delimited
    # DatabaseName|HostName|UserName|Password
    open CRED, '<', "$home/.dbcredentials";
    my $cred = <CRED>;
    chomp($cred);
    my ( $db, $host, $username, $password ) = split( /\|/, $cred );
    my $dsn = "DBI:mysql:database=$db;host=$host";
    close CRED;
    return ( DBI->connect_cached( $dsn, $username, $password ) );
}

# --------------------------------------------------------------------------- #
sub now {

    # get the system time and return it in ISO format (yyyy-mm-dd 23:59)
    return ( strftime( "%Y-%m-%d %T", localtime() ) );
}

# --------------------------------------------------------------------------- #
sub elapsed_time {

    # given a start time, return the elapsed time in milliseconds
    my $start = shift;
    return sprintf "%.3f", ( ( time() - $start ) * 1000 );
}

# --------------------------------------------------------------------------- #
sub logmsg {
    my ( $message, $level ) = @_;
    $level = 1 unless defined($level);

    # Write a message to the configured log if the message level is at the
    # current verbosity level or higher.
    #
    # This extra layer of logging may seem redundant, but many years spent in
    # systems operations have taught me the value of instrumenting your code
    # (particuarly when you get paged at 3am to resolve an issue)

    return if $level > $verbosity;    # bail immediately if not verbose enough

    if ( defined $logfile ) {
        my $ts = now();
        print LOG "[$ts] $message\n";
    }
    else {
        carp($message);
    }
}

# --------------------------------------------------------------------------- #