#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################
#                                                                     #
# THIS MODULE CONTAINS VARIOUS FUNCTIONS USED BY DODO.                #
# A general purpose Database connection module                        #
#                                                                     #
#######################################################################
package Database;
use WrapDBI;
use Tk::WaitBox;
use vars qw(%SIG);
use DBI;
use dodo_utilities;




sub new
{
my $pkg = shift;
my $data = {};
bless $data,$pkg;
return $data;
}


sub Currentdb
{
my $pkg = shift;

if (@_){$pkg->{db} = shift;}
else {return $pkg->{db};}
}



sub Initialisedb
{
my $pkg = shift;

$pkg->{User} 		= 'dodo';
$pkg->{Oracle} 		= '/usr/local/oracle';
$pkg->{DB} 		= 'sids';

unshift(@INC,"/usr/local/badger/bin");
$ENV{ORACLE_HOME} 	= $pkg->{Oracle};
$ENV{TWO_TASK} 		= $pkg->{DB};
$pkg->{Debug} 		= 0;

}


sub Locationdb
{
my $pkg = shift;
if ((@_) && (-s $_[0]))
	{$pkg->{Oracle} = shift;
	return undef;}
else
	{
	if (@_){die "Attempted to set invalid drive ($_[0]) as location of Oracle.\n($pkg->{Oracle}) used instead\n";} 
	return $pkg->{Oracle};
	}
}




sub MultiWritedb
{
my ($pkg,@sql) = @_;
my $idlist;

eval 
{
foreach (@sql)
{
	$idlist = $pkg->{dbh}->prepare($_);
	$idlist->execute();
	$idlist->finish;
}
$pkg->{dbh}->commit;


};
if ($@){$pkg->{dbh}->rollback; print STDERR "Error Writing to DB Database\n$@\n";}


}




sub Querydb
{
my ($pkg,$sql) = @_;
my $ref;
my $entries;
my $columns;
my $dbh;

eval{

my $idlist = $pkg->{dbh}->prepare($sql);
$idlist->execute();
	 
	if ($DBI::err)
	{die "Error: $idlist->errstr \n";}
	else
	{
	my $fields = $idlist->{'NUM_OF_FIELDS'};
	my $headers = $idlist->{'NAME'};
	$ref = $idlist->fetchall_arrayref;
	
# For debugging
if($pkg->{Debug} == 1)
{
	for($columns = 0; $columns < $fields; $columns ++)
	{print "$$headers[$columns]..";}
	print "\n";
		
	
	for($entries = 0; $entries < @$ref; $entries++)
	{
		for($columns = 0; $columns < $fields; $columns ++)
		{print "$ref->[$entries][$columns]..";}
		print "\n";
	}
	
	}
}
	$idlist->finish;

	
};

if($@ =~ /ORA-00054:/)
	{$pkg->{dbh}->rollback; die "LOCK OUT :\nSelected Rows in Oracle Are Currently Locked By Another User.\nPlease try Again Later\n\nIf Problem
	persists, contact bug ORA-00054:\n\n";}
if($@)
	{$pkg->{dbh}->rollback; die "\nCannot Query Oracle\n$@";}
else
	{return $ref;}
}




sub Userdb
{
my $pkg = shift;
if (@_){$pkg->{User} = shift;}
else {return $pkg->{User};}
}



sub Writedb
{
my ($pkg,$sql) = @_;
my $idlist;

eval
{
	$idlist = $pkg->{dbh}->prepare($sql)|| die "ERROR:$DBI::errstr";
	$idlist->execute || print STDERR "ERROR:$DBI::errstr";
	$idlist->finish;
};
if($@ =~ /ORA-00054:/)
	{
	$pkg->{dbh}->rollback; print STDERR "LOCK OUT :Selected Rows in Oracle Are Currently Locked By
	Another User.\nPlease try Again Later\n\nIf Problem persists, contact bug ORA-00054\n\n";}
if($@)
	{$pkg->{dbh}->rollback; print STDERR "\nCannot Write Data To Oracle\n$@";}
else
	{return;}

}






sub Connect_To_DB
{
my $pkg = shift;

eval {$pkg->{dbh} = WrapDBI->connect($pkg->{User}, {RaiseError => 1});};

if ($@)
	{print STDERR "Could Not Connect To Database\n$@";
	return 1;}
else
	{return 0;}

}


sub Boundwrite {
my ($pkg, $sql, $values) = @_;
my $ref;
my $prepare;

eval {
$prepare = $pkg->{dbh}->prepare($sql);
foreach (@{$values})
{
	$prepare->execute($_);
}
};if($@){
	if($pkg->{"dbh"})
	{
		$pkg->{"dbh"}->rollback;
	} 
	die "\n\nBoundwrite Failed\n\n$@\n";
	}
}






1;
