# $Id: Comas.pm,v 1.29 2004/11/20 17:10:24 mig Exp $
######################################
# Comas - Conference Management System
######################################
# Copyright 2003 CONSOL
# Congreso Nacional de Software Libre (http://www.consol.org.mx/)
#   Gunnar Wolf <gwolf@gwolf.cx>
#   Manuel Rabade <mig@mig-29.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
######################################

######################################
# Module: Apache::Comas
# mod_perl handler routines
######################################
# Depends on:
#
# Apache::Constants - Constants defined in apache header files
# Apache::Cookie - HTTP Cookies Class
# Apache::Request - Methods for dealing with client request data
# Config::Simple - simple configuration file class
# Comas::DB - Handles the database connectivity for a Comas module
# Apache::Session::Postgres - An implementation of Apache::Session
# Comas::HTML module (part of Comas' main distribution)
# Should only be used from a mod_perl environment

use strict;
use warnings;

package Apache::Comas;

use Apache::Constants qw(:common);
use Apache::Cookie;
use Apache::Request;
use Apache::Session::Postgres;
use Config::Simple;
use Comas::DB;
use Comas::HTML;

=head1 NAME

Apache::Comas - mod_perl handler routines for Comas

=head1 SYNOPSIS

Apache::Comas should be called from an Apache server with an active 
mod_perl installation. In order to run, you should include something
like this in your Apache's httpd.conf file:

<IfModule mod_perl.c>
  <Location /comas>
      SetHandler perl-script
      PerlHandler Apache::Comas
      PerlSetVar comas_config_file /etc/comas.conf
      PerlSetVar comas_instance    consol
  </Location>
</IfModule>

Please read mod_perl's documentation for further options.

=head1 REQUIRES

Comas::HTML
Comas::DB
Config::Simple
Apache::Constants
Apache::Session
Apache::Cookie
Apache::Request

=head1 EXPORTS

Nothing

=head1 SEE ALSO

Comas::HTML

=head1 AUTHOR

Gunnar Wolf, gwolf@gwolf.cx
Manuel Rabade, mig@mig-29.net

Comas has been developed for CONSOL, Congreso Nacional de Software Libre,
http://www.consol.org.mx/

=head1 COPYRIGHT

Copyright 2003 Gunnar Wolf and Manuel Rabade

This library is free software, you can redistribute it and/or modify it
    under the terms of the GPL version 2 or later.
    
=cut

sub handler {
    my $r = shift;
    my (@path, $request, $status, $upload, %params, %session, $cookie, @ret,
        $tmpl_path, $html, $instance, $debug);
    my ($cfg, $valid_cfg, $req_cfg, %db_cfg, %db_adm_cfg, $db, $db_adm,
        $session_timeout, $max_upload);

    (undef, @path) = split('/', $r->path_info);

    #################################################################
    # Configuration File    

    # Somebody forget the PerlSetVar ?
    if (! defined $r->dir_config('comas_config_file') ||
        ! defined $r->dir_config('comas_instance')) {
        die 'Apache::Comas configuration missing (check yout httpd.conf)';
    } else {
        $instance = $r->dir_config('comas_instance');
    }

    # Is debug set up ?
    if (defined $r->dir_config('debug')) {
        $debug = 1;
    }

    # We load the configuration.
    $cfg = Config::Simple->new($r->dir_config('comas_config_file'));

    unless (defined $cfg) {
        die 'Could not open configuration file ',
        $r->dir_config('comas_config_file');
    }

    # The valid configuration keys.
    $valid_cfg = { dbname => 1, host => 1, port => 1, dbuser => 1,
                   dbpasswd => 1, adm_dbuser => 1, adm_dbpasswd => 1,
		   tmpl_path => 1, session_timeout => 1, max_upload => 1,
                   session_timeout => 1 };

    # The required configuration keys. We tag them with zeros, will check for 
    # their presence soon.
    $req_cfg = { dbname => 0,  dbuser => 0, dbpasswd => 0, adm_dbuser => 0,
		 adm_dbpasswd => 0, tmpl_path => 0};

    # Here we prase the configuration file
    foreach my $cfg_key (keys %{$cfg->vars}) {
        my $temp_key;
        
        # We separate the keys of the file (they are in the notation block.key).
        my ($inst, $key) = split(/\./, $cfg_key);

	# Take note that the key was present
	$req_cfg->{$key}++ if exists $req_cfg->{$key};
        
        # If the key dont belong to our instance we drop it.
        next if ($inst ne $instance);

        unless ($valid_cfg->{$key}) {
            die 'Invalid configuration key: ', $key, ', at section: ', $inst;
        }
        
        if ($key eq 'dbuser' || $key eq 'dbpasswd') {
            $db_cfg{"-$key"} = $cfg->param("$instance.$key");
        } elsif ($key eq 'adm_dbuser' || $key eq 'adm_dbpasswd') {
            ($temp_key = $key) =~ s/^adm_//;
            $db_adm_cfg{"-$temp_key"} = $cfg->param("$instance.$key");
	} elsif ($key eq 'tmpl_path') {
	    $tmpl_path = $cfg->param("$instance.$key");
        } elsif ($key eq 'session_timeout') {
            $session_timeout = $cfg->param("$instance.$key");
        } elsif ($key eq 'max_upload') {
            $max_upload = $cfg->param("$instance.$key");
        } else {
            $db_cfg{"-$key"} = $cfg->param("$instance.$key");
            $db_adm_cfg{"-$key"} = $cfg->param("$instance.$key");
        }
    }

    if (my @missing = grep {! $req_cfg->{$_}} keys %$req_cfg) {
	warn 'Required configuration keys missing: ', join(', ', @missing);
    }
    
    # Default values for optional configuration values
    unless (defined $session_timeout) {
        $session_timeout = 3600;
    }
    # Default maximum upload size is 10MB
    unless (defined $max_upload) {
        $max_upload = 10;
    }

    #################################################################
    # Everything that we need from Apache
    $request = Apache::Request->new($r, POST_MAX => $max_upload * 1024 * 1024,
                                    DISABLE_UPLOADS => 0);
    $status = $request->parse;
    $upload = $request->upload;
    $cookie = Apache::Cookie->fetch;

    # We process the parameter list this way in order to be able to deal with
    # multivalued parameters (i.e. checkbox groups).
    for my $key (keys %{$request->param}) {
	my @values = $request->param($key);
	$params{$key} = scalar(@values) > 1 ? [@values] : $values[0];
    }
    
    #################################################################
    # Comas::DB Objetcts
    # Here we create two databse objets, one with the normal comas user and
    # other with the administrative user.
    $db = Comas::DB->new(%db_cfg);
    $db_adm = Comas::DB->new(%db_adm_cfg);

    if (! defined $db or ! defined $db_adm) {
        die 'Could not connect to the database, check your configuration file';
    }

    #################################################################
    # Session
    
    if (defined $cookie->{'comas_session'}) {
        # We have a cookie !, let's use the session.
        eval {
            tie %session, 'Apache::Session::Postgres',
            $cookie->{'comas_session'}->value,
            {Handle => $db->{-dbh}, Commit => 0};
        };
        
        # This is because if the client have a cookie with a session but we
        # rebuild the database and the session in the cookie don't exist
        # Apache::Session will die, so if it dies, we undef the cookie to
        # recrate it later as a new session.
        if ($@) {
            delete $cookie->{'comas_session'};
        } else {
            if (defined $session{last_visit}) {
                if (($session{last_visit} + ($session_timeout * 60)) < time) {
                    delete $cookie->{'comas_session'};
                    tied(%session)->delete;
                } else {
                    $session{last_visit} = time;
                }
            } else {
                delete $cookie->{'comas_session'};
            }
        }
    }
    
    unless (defined $cookie->{'comas_session'}) {
        # Ups .. there is no cookie, let's create a new cookie and session !
        my $new_cookie;
        tie %session, 'Apache::Session::Postgres',
        undef,
        {Handle => $db->{-dbh}, Commit => 0};
        $new_cookie = Apache::Cookie->new($r,
                                          -name => 'comas_session',
                                          -value => $session{_session_id},
                                          -expires => '+3M');
        $session{last_visit} = time;
        $new_cookie->bake;
    }

    #################################################################
    # All the HTML stuff

    # We create a Comas::HTML object with the needed information
    $html = Comas::HTML->new(-db => $db, # General database handle
                             -db_adm => $db_adm, # Administrative DB handle
                             -path => \@path, # Path_info sent by browser
                             -params => \%params, # CGI parameters
                             -session => \%session, # Session information
                             -upload => $upload, # File upload, if any
			     -tmpl_path => $tmpl_path); # Path for templates

    # If something bad happen.
    unless (defined $html) {
        die 'Could not create Comas::HTML object, bailing out';
    }
    
    $ret[0] = $html->process;

    ##############################################################
    #### Aqui hay que hacer mas flexible el asunto de las headers.
    #### Porque la API de mod_perl proporciona solo metodos para
    #### algunos headers, los demas son con header_out

    if ($html->http_headers) {
        my %headers = $html->http_headers;
        unless(defined $headers{Content_Type}) {
            $r->content_type('text/html');
            # Only if we are displaying text or html we send the debug,
            # otherwise we don't send it
            if ($debug) {
                $ret[1] = $html->debug_object;
            }
        } else {
            $r->content_type($headers{Content_Type});
            delete $headers{Content_Type};
        }
        
        if (scalar keys %headers > 0) {
            foreach my $header (keys %headers) {
                my $header2 = $header;
                $header2 =~ s/_/-/g;
                $r->header_out($header2, $headers{$header});
            }
        }
    } else {
        $r->content_type('text/html');
        # Only if we are displaying text or html we send the debug,
        # otherwise we don't send it
        if ($debug) {
            $ret[1] = $html->debug_object;
        }
    }
    untie(%session);
    
    # We send the header and the results of Comas::HTML    
    $r->send_http_header;
    $r->print(@ret);
    return OK; 
}

1;


# $Log: Comas.pm,v $
# Revision 1.29  2004/11/20 17:10:24  mig
# - Missing valid keys for configuration file (session_timeout and max_upload).
#
# Revision 1.28  2004/11/15 05:38:49  gwolf
# Fixed some documentation typos
# Filled in missing minimal_db information
# Created templates.xml
#
# Revision 1.27  2004/11/12 05:41:16  gwolf
# Typo correction
#
# Revision 1.26  2004/10/19 06:34:53  mig
# - Session timeout and limit of file uploads can be defined via the
#   configuration file.
#
# Revision 1.25  2004/07/24 18:17:34  gwolf
# Fixed the way in which parameter passing is made, in order to accept
# multiple values for a single parameter (say, for checkboxes)
#
# Revision 1.24  2004/07/08 00:15:46  gwolf
# Handling Comas' and the conference's base URL in the configuration,
# not hard-coded in the HTML templates themselves
#
# Revision 1.23  2004/06/01 01:41:30  gwolf
# A valid tmpl_path (path to the HTML templates) is valid before the
# system is used for the first time. I decided to move the tmpl_path
# configuration from the 'config' table in the DB to the Comas
# configuration file.
#
# Revision 1.22  2004/05/17 23:22:09  gwolf
# Strange, had to put a space after 'die' - Is it a Perl 5.8.4 quirk?
#
# Revision 1.21  2004/04/23 19:47:01  gwolf
# Requires the configuration file to be valid for this instance
#
# Revision 1.20  2004/04/17 20:00:32  mig
# - Bug-fix that broke the interaction with Data::FormValidator > 3.15
#
# Revision 1.19  2004/02/05 21:58:23  mig
# - Corrigo warning del modo debug
#
# Revision 1.18  2004/01/31 06:20:25  mig
# - Mas documentacion
#
# Revision 1.17  2003/12/24 08:47:46  mig
# - Desde httpd.conf le seteamos si quieremos debug :)
#
# Revision 1.16  2003/12/21 04:28:15  mig
# - Mas limpio el asunto de las headers.
#
# Revision 1.15  2003/12/20 04:14:51  mig
# - Agrego tags Id y Log que expanda el CVS
#
