view release on metacpan or  search on metacpan

lib/Apache/iNcom.pm  view on Meta::CPAN

#
#    iNcom.pm - Main module of the iNcom package.
#
#    This file is part of Apache::iNcom
#
#    Author: Francis J. Lacoste <francis.lacoste@iNsu.COM>
#
#    Copyright (C) 1999 Francis J. Lacoste, iNsu Innovations
#
#    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
#
package Apache::iNcom;

use strict;

require 5.005;

use DBI;

use Apache;
use Apache::Log;
use Apache::Cookie;
use Apache::Request;
use Apache::File;
use Apache::Constants qw( :common :response HTTP_PRECONDITION_FAILED );

use HTML::Embperl;

use Apache::iNcom::Request;
use Apache::iNcom::Localizer;

use vars qw($VERSION);
BEGIN {
    ($VERSION) = '0.09';
}

my %VALID_PNOTES = map { $_ => 1 } qw (
    INCOM_SESSION INCOM_DBH INCOM_LOCALIZER INCOM_COOKIES
);

# Grabbed from CGI.pm by Lincoln Stein
sub offset_calc {
    my($time) = @_;
    my(%mult) = ('s'=>1,
                 'm'=>60,
                 'h'=>60*60,
                 'd'=>60*60*24,
                 'M'=>60*60*24*30,
                 'y'=>60*60*24*365);
    # format for time can be in any of the forms...
    # "now" -- expire immediately
    # "+180s" -- in 180 seconds
    # "+2m" -- in 2 minutes
    # "+12h" -- in 12 hours
    # "+1d"  -- in 1 day
    # "+3M"  -- in 3 months
    # "+2y"  -- in 2 years
    # "-3m"  -- 3 minutes ago(!)
    my($offset);
    if (!$time || (lc($time) eq 'now')) {
        $offset = 0;
    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
        $offset = ($mult{$2} || 1)*$1;
    } else {
	die "invalid expiration offset: $time\n";
    }
    return ($offset);
}

sub db_init {
    my $r = shift;
    my $dsn	= $r->dir_config( "INCOM_DBI_DSN" );
    my $user	= $r->dir_config( "INCOM_DBI_USER" );
    my $passwd	= $r->dir_config( "INCOM_DBI_PASSWD" );

    unless ( $dsn ) {
	$r->log_error( "iNcom configuration error: INCOM_DBI_DSN is not defined" );
	return SERVER_ERROR;
    }

    my $dbh;
    eval {
	$dbh = DBI->connect( $dsn, $user, $passwd, { RaiseError => 1,
						     AutoCommit => 0,
						   } );
	my $trace_lvl  = $r->dir_config( "INCOM_DBI_TRACE" );
	my $trace_file = $r->dir_config( "INCOM_DBI_LOG"   );

	# Turn tracing on if requested
	if ( $trace_lvl ) {
	    $trace_file = $r->server_root_relative( $trace_file )
	      if defined $trace_file;
	    $dbh->trace( $trace_lvl, $trace_file );
	}

	# Saves it in the request record for access from
	# other handlers
	$r->pnotes( INCOM_DBH => $dbh );

    };
    if ($@ ) {
	$r->log_error( "error opening connection to database: $@" );
	return return_error( $r, SERVER_ERROR );
    }
    return OK;
}

sub i18n_init {
    my $r = shift;