package Login_base;
use strict;
use vars qw (@ISA @EXPORT_OK);
use Exporter;
@ISA = ('Exporter');
@EXPORT_OK = qw(ConnectToDatabase);


# Author : Gavin Sherlock
# Date   : October 1999

# This package exports a single function call that returns a handle to a database.

# Currently it is pretty stupid, in that it uses database specific libraries
# to print out connection errors back to a web page.  A far cleaner approach
# would be to pass in a reference to an error handling routine from the client
# which would be called with an error message.  This would entail large scale
# changes, in that every client program would need to change, and so has not
# been high on the list of priorities.

# In addition, changing the calling syntax to be more obvious would also be nice,
# eg my $dbh = &ConnectToDatabase(database=>$database,
#                                 user=>$user,
#                                 pass=>$pass,
#                                 errorHandler=>\&errorHandler);
#
# with the last 3 arguments being optional.  This has not yet been implemented,
# again because of the changes to client programs that would be required 

use lib "/usr/local/dicty/www_dictybase/db/lib/dictyBase";

use DBI;
use CGI qw/:standard :html3/;
#use CGI::Carp qw(fatalsToBrowser);

use FormatdictyBase qw (PrintPageTop Divider75 FooterReturnEmail);

####################################################################################
sub ConnectToDatabase{
####################################################################################
# This will return a database handle to the specified database, which must be passed
# in as the first argument.  If a username and password are passed
# into the function, the it will use those to log on, otherwise it will default to 
# webb

# Usage : my $dbh = &ConnectToDatabase($database, $user, $pass);
# 
# $user and $pass are optional.  If no user is supplied, the function will
# default to the user CGM_DDB.  If no password is supplied, the function will
# attempt to get the correct password for the user.

    my $database = lc(shift)
	|| die "Error you must pass a database name as the first argument to ConnectToDataBase\n";
    my $user = uc(shift) || $ENV{'DBUSER'};
    my $pass = shift || &GetPassword($database, $user);

    &SetEnvironment($database);

    my $dbh;

    if (-e "/ora0/app/oracle/admin/$database/logs/NO_CGI_ACCESS" && $0 =~ /cgi/){

	&PrintConnectionError($database, "The database is currently unavailable for technical reasons.");

    }elsif (-e "/ora0/app/oracle/admin/$database/logs/NO_ACCESS"){

	&PrintConnectionError($database, "The database is currently unavailable for technical reasons.");

    }elsif ($database eq "mad"){

	&PrintConnectionError($database, "\n\nThe mad database is no loger available on wine.\n\n");

    }

    eval {
    
	$dbh = DBI->connect("dbi:Oracle:$database", $user, $pass, { RaiseError=>1, AutoCommit=>0 });
    
    };
    
    if ($@) {
	my $error = h2("Cannot connect to the oracle server named <font color=red>$database</font>:<br>$DBI::errstr\n");
        &PrintConnectionError($database, $error);
    }

    return $dbh;

}

###################################################################################
sub GetPassword{
###################################################################################
# This subroutine uses the dbauth program to retrieve the password for a particular 
# user in a particular database

    my ($database, $user) = @_;

    my $password = `/usr/local/bin/db-auth $user\@$database`;

    chomp $password;

    if ($?){ # error in script

	&PrintConnectionError($database, h2("An error occurred during authentication."));

    }elsif(!$password){ # didn't get a password

	&PrintConnectionError($database, h2("An error occurred.  No authentication was provided."));
                                 
    }

    return ($password);

}
###################################################################################
sub SetEnvironment{
###################################################################################
# This subroutine simply sets up some environment variables.  Currently all databases
# have the same environment, but as this may change in the future, it was thought to
# be better to abstract this now.  This function is not exported, and can only be called
# from within this module.

    my $database = shift
	|| die "Error you must pass a database name to SetEnvironment";

    # set up environment
    
    $ENV {"PERL5LIB"} = "C:/web/xampp/perl/site/lib";
    $ENV {"ORACLE_HOME"} = "D:/oracle/ora92";

}


####################################################################################
sub PrintConnectionError{
####################################################################################
# This subroutine prints out that an error occured when trying to connect to the
# database, then exits

    my ($database, $error) = @_;

    if ($database =~ /(dictyBase|sdev)/i) {
	my $query = new CGI;
	print $query->header;
	print $query->start_html(-'title'=>"dictyBase Login Error Report", -style=>{'src'=>'http:///usr/local/dicty/www_dictybase/db/lib/style.css'}, -BGCOLOR=>"#FFFFFF");
	&PrintPageTop("dictyBase", "dictyBase Login Error Report");
	print "<p>";
	if ($database =~ /dictyBase/i) { print $error };
	print h4("The database is currently not available, and may be down for maintenance, or being backed up.\n");
	print "Please try your request later.\n", br;
	print "Sorry for any inconvenience this may have caused you.\n", br;
	print &Divider75;
	print &FooterReturnEmail;
	print $query->end_html;
    } elsif ($database =~/gen/i){
        my $query = new CGI;
        print $query->header;
        print $query->start_html(-'title'=>"Login Error Report", -style=>{'src'=>'http:///usr/local/dicty/www_dictybase/db/lib/style.css'}, -BGCOLOR=>"#FFFFFF");
        print "<center>";
        print h2("Login Error Report");
        print "</center>";
        print "<p>";
        print h4("The database is currently not available, and may be down for maintenance, or being backed up.\n");
        print "Please try your request later.\n", br;
        print "Sorry for any inconvenience this may have caused you.\n", br;
        print &Divider75;
        print $query->end_html;

    } 
    else {
	print $error;
    }
    exit;

}

1;