# FILE: dbint.pl
# DESCRIPTION: Interfaces to database (MySQL)
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

#*******************************************************************************
# NOTE: To connect to other SQL databases that use syntax similar to MySQL,
# edit the db_connect subroutine, removing 'mysql' and inserting whatever you
# need.  Please keep us advised of progress on integrating other database
# systems by contacting us at support@discusware.com
#
# Create a MySQL database by issuing these commands from the shell:
#     mysqladmin -uroot -p create xxxxxxx
#     mysql -uroot -p mysql
#     > GRANT ALL PRIVILEGES ON xxxxxxx.* TO yyyyyyy@localhost [IDENTIFIED BY 'password'];
#     > exit;
# where 'xxxxxxx' is the name of the database and yyyyyyy is the username
# authorized to access that database (and optionally enter a password)
#*******************************************************************************

use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);

###
### sql_lock
###
### Gets a file lock using an SQL table rather than a file
###

sub sql_lock {
	my ($fileref, $subroutine, $maxtime) = @_;
	my $dbh = database_dbh();
	my $tries = 0;
	$maxtime = 7 if $maxtime == 0;
	my $timecache = time;
	my $processid = $$;
	my $cachetime = $timecache - $maxtime;
	my @files = ();
	foreach my $f (@{ $fileref }) {
		if ($f eq "*") { push @files, "GLOBAL"; }
		elsif ($f =~ m|.*/(.*)|) { push @files, $1; }
		else { push @files, $f; }
	}
	return 1 if scalar(@files) == 0;

	## Clear out expired locks

	db_query("DELETE FROM $PARAMS->{db_prefix}locks WHERE timecreate < $cachetime;");

	## Check for a global lock

	my $selectquery1 = db_sql_query(undef, "locks", "select", { filename => "GLOBAL" });
	if ($selectquery1->[0]->{filename} eq "GLOBAL") {
		my $es = read_language()->{'FILELOCKREGEN'}; $es =~ s/\%sec/7/g;
		log_error("dbint.pl", "sql_lock", "Request for lock by $subroutine on GLOBAL failed... [$selectquery1->[0]->{processid},$processid] (GLOBAL LOCK exists)");
		error_message(read_language()->{'FILELOCKERROR'}, "$es [GLOBAL]", 0, 1);
	}

	## Check for lock on topics file for regeneration

	if ($subroutine eq "change_board_colors" && scalar(@files) == 1 && $files[0] eq "board-topics.html") {
		my $rv = db_sql_query({ filename => $files[0], processid => $processid, timecreate => $timecache }, "locks", "insert", undef, undef, 1);
		my @rv = @{ $rv };
		return 0 if grep { $_->{FAILURE} == 1 } @rv;
		return 1;
	}

	## Check for lock when regenerating subtopic page
	
	if ($subroutine eq "--REGENERATE-SUBTOPICS--") {
		my $rv = db_sql_query({ filename => $files[0], processid => $processid, timecreate => $timecache }, "locks", "insert", undef, undef, 1);
		my @rv = @{ $rv };
		return 0 if grep { $_->{FAILURE} == 1 } @rv;
		return 1;
	}

	## Lock actual files

	my %h = map { $_, 1 } @files;
	my %success_lock = ();
	while (scalar(keys(%h)) > 0 && $tries <= 20) {
		$tries++;
		foreach my $key (keys(%h)) {
			my $rv = db_sql_query({ filename => $key, processid => $processid, timecreate => $timecache }, "locks", "insert", undef, undef, 1);
			my @rv = @{ $rv };
			if (! grep { $_->{FAILURE} == 1 } @rv) {
				delete $h{$key};
				$success_lock{$key} = 1;
				$tries = 0;
				$PARAMS->{files_locked_list}->{$key} = 1;
			}
		}
	}

	## Was this successful?

	return 1 if scalar(keys(%h)) == 0;

	## If not successful, remove any successful locks and give error message

	my $fail_file = (keys(%h))[0];
	my @unlocks = grep { $PARAMS->{files_locked_list}->{$_} == 1 && $h{$_} == 0 } keys %{$PARAMS->{files_locked_list}};
	foreach my $suc (@unlocks) { _sql_unlock($suc); }
	log_error("dbint.pl", "sql_lock", "Request for lock by $subroutine on $fail_file failed... [$subroutine,$processid]");
	error_message(read_language()->{'FILELOCKERROR'}, join(" ", read_language()->{FILEISLOCKED}, "[$fail_file]"), 0, 1);
}

###
### sql_unlock
###
### Releases a file lock using an SQL table rather than a file
###

sub sql_unlock {
	my ($fileref) = @_;
	my $sth = database_dbh()->prepare("DELETE FROM $PARAMS->{db_prefix}locks WHERE filename = ?;");
	my @files = ();
	foreach my $f (@{ $fileref }) {
		if ($f eq "*") { push @files, "GLOBAL"; }
		elsif ($f =~ m|.*/(.*)|) { push @files, $1; }
		else { push @files, $f; }
		$PARAMS->{files_locked_list}->{$files[$#files]} = 0;
	}
	map { $sth->execute($_) } @files;
	return 1;
}

sub _sql_unlock {
	my ($filename) = @_;
	db_sql_query(undef, "locks", "delete", { filename => $filename });
}

###
### db_connect
###
### Connects you to your database.
###

sub db_connect {
	my ($arg) = @_;
	return $PARAMS->{dbh} if (defined $PARAMS->{dbh} && ! $arg);
	return ($PARAMS->{dbh}, "") if (defined $PARAMS->{dbh} && $arg != 2);
	my $db_param = {};
	touch_createfile("$DCONF->{admin_dir}/data/db.txt");
	if (open(DB_CONFIG, "$DCONF->{admin_dir}/data/db.txt")) {
		my @db = <DB_CONFIG>;
		close (DB_CONFIG);
		foreach my $x (@db) {
			if ($x =~ m|^(\w+)=(.*)|) {
				$db_param->{$1} = $2;
			}
		}
	} else {
		error_message("Database Connect Error", "Configuration file (db.txt) does not exist or is not readable!");
	}
	$PARAMS->{db_prefix} = $db_param->{prefix} if ! defined $PARAMS->{db_prefix};
	eval 'use DBI;';
	error_message("Database Connect Error", "The chosen Perl distribution does not support the DBI module.", 0, 1) if $@ ne "";
	my $database = $db_param->{'database'};
	$PARAMS->{db_prefix} = defined $db_param->{'prefix'} ? join("", trim($db_param->{'prefix'}), "_") : "";
	my $socket_str = $db_param->{force_socket} ne "" ? ":mysql_socket=$db_param->{force_socket}" : "";

	#------------------------------------------------------------------------------------------
	# Note: to use non-MySQL database, you'll need to figure out what to do with this next line
	#
#	DBI->trace(3);
	if (my $h = DBI->connect("DBI:mysql:$database$socket_str", $db_param->{'username'}, $db_param->{'password'}, {PrintError => 0 })) {
	#
	#------------------------------------------------------------------------------------------

		return ($h, "") if $arg == 1;
		return $h;
	} else {
		error_message("Database Connect Error", "Could not connect to database <B>$database</B>.<p>Error message is: <FONT COLOR=#800080>$DBI::errstr</FONT>.  Argument is $arg.", 0, 1) if $arg != 2;
		return (undef, $DBI::errstr);
	}
}

###
### db_sql_query
###
### General function to take a hash and convert it into a SQL query
###

sub db_sql_query {
	my ($hash3, $database3, $qtype, $where3, $dbh, $noerr) = @_;
	$dbh = database_dbh() if ! defined $dbh;
	my @nh = defined $hash3 ? (ref $hash3 eq "HASH" ? ($hash3) : @{ $hash3 }) : ();
	my @wh = defined $where3 ? (ref $where3 eq "HASH" ? ($where3) : @{ $where3 }) : ();
	my $hash0 = $nh[0];
	my $where0 = $wh[0];
	my @ar = keys(%{ $hash0 });
	my @d = split(/,/, $database3);
	my @r = ();
	foreach my $database (@d) {
		my $sql_str = "";
		if ($qtype =~ m|^insert$|i || $qtype =~ m|^replace$|i) {
			my $i = $qtype =~ m|^insert$|i ? "INSERT" : "REPLACE";
			$sql_str = "$i INTO $PARAMS->{db_prefix}$database (";
			$sql_str .= join(",", @ar);
			$sql_str .= ") VALUES ";
			$sql_str .= _db_sql_query_questionmarks(\@ar);
		} elsif ($qtype =~ m|^update$|i) {
			$sql_str = "UPDATE $PARAMS->{db_prefix}$database SET ";
			foreach my $a (@ar) {
				$sql_str .= "$a=?,";
			}
			$sql_str =~ s/,$//;
			$sql_str .= _db_sql_query_where($where0);
		} elsif ($qtype =~ m|^delete$|i) {
			$sql_str = "DELETE FROM $PARAMS->{db_prefix}$database";
			$sql_str .= _db_sql_query_where($where0);
		} elsif ($qtype =~ m|^select$|i) {
			$sql_str = "SELECT * FROM $PARAMS->{db_prefix}$database";
			$sql_str .= _db_sql_query_where($where0);
		}
		$sql_str =~ s/\s+$//;
		$sql_str .= ";";
		if (scalar(@wh) == 0) {
			push @wh, {} until scalar(@wh) >= scalar(@nh);
		}
		if (defined $dbh) {
			my $statement = $sql_str;
			my $sth = undef;
			unless ($sth = $dbh->prepare($statement)) {
				log_error("dbint.pl", "db_sql_query", "Could not prepare statement [$statement]... " . $dbh->errstr());
				error_message("Database Query Error", "Could not prepare statement [$statement]... " . $dbh->errstr());
			}
			if (scalar(@wh)) {
				foreach my $wh (@wh) {
					my $nh = shift @nh;
					my @v = values(%{ $nh });
					push @v, values(%{ $wh }) if $sql_str =~ m| WHERE |;
					if (! $sth->execute(@v)) {
						push @r, { FAILURE => 1, FAILURE_MESSAGE => $DBI::errstr, FAILURE_NOTE => $statement };
						error_message($statement, join("-", @v) . "<br>" . $dbh->errstr()) if ! $noerr;
						log_error("dbint.pl", "db_sql_query", "Could not execute [$statement]... " . $dbh->errstr());
						last if $noerr;
					} else {
						if ($qtype =~ m|^select$|i) {
							while (my $h = $sth->fetchrow_hashref()) {
								$h->{database} = $database;
								$h->{FAILURE} = 0;
								push @r, \%{ $h };
							}
						} else {
							push @r, { FAILURE => 0, rows => $sth->rows() };
						}
					}
				}
			} else {
				$sth->execute();
				if ($qtype =~ m|^select$|i) {
					while (my $h = $sth->fetchrow_hashref()) {
						$h->{database} = $database;
						$h->{FAILURE} = 0;
						push @r, \%{ $h };
					}
				} else {
					push @r, { FAILURE => 0, rows => $sth->rows() };
				}
			}
			$sth->finish();
		} else {
			push @r, $sql_str;
		}
	}
	return \@r;
}

sub _db_sql_query_questionmarks {
	my ($arr, $jstr) = @_;
	my $sc = scalar(@{ $arr });
	$jstr = "?," if ! $jstr;
	my $j = $jstr x $sc;
	$j =~ s/,$//;
	return join("", "(", $j, ")");
}

sub _db_sql_query_where {
	my ($where) = @_;
	return "" if ref $where ne 'HASH' || keys(%{ $where }) == 0;
	my $sq_st = "";
	foreach my $k (keys(%{ $where })) {
		$sq_st .= "$k=? OR ";
	}
	$sq_st =~ s/OR\s+$//;
	return "" if $sq_st eq "";
	return " WHERE $sq_st";
}

###
### db_query
###
### Prepares and then executes an SQL query, with full debugging messages. Used
### for more unusual commands (dropping tables, etc.)
###

sub db_query {
	my ($statement, $dbh, $nofail, $executestuff) = @_;
	$dbh = database_dbh() if ! defined $dbh;
	my ($sth);
	unless ($sth = $dbh->prepare($statement)) {
		log_error("dbint.pl", "db_query", "Could not prepare statement [$statement]... " . $dbh->errstr());
		error_message("Database Query Error", "Could not prepare statement [$statement]... " . $dbh->errstr()) if !$nofail;
		return undef;
	}
	unless ($sth->execute(@{$executestuff})) {
		log_error("dbint.pl", "db_query", "Could not execute statement [$statement]... " . $dbh->errstr());
		error_message("Database Query Error", "Could not execute statement [$statement]... " . $dbh->errstr()) if !$nofail;
		return undef;
	}
	$sth->finish();
	return 1;
}

###
### db_var_val
###
### Converts an array of 'var' and 'val' hashes to one suitable for
### db_sql_query
###

sub db_var_val {
	my $b = {};
	while (my $a = shift @_) {
		$b->{ $a->{var}} = join("", "", $a->{val});
	}
	return $b;
}

###
### db_defined_val
###
### Converts from a series of defined hashes to one suitable for
### db_sql_query
###

sub db_defined_val {
	my ($hash, $keyset) = @_;
	my @a = ();
	foreach my $k (keys(%{ $hash })) {
		push @a, { $keyset => $k };
	}
	return \@a;
}

###
### db_fields
###
### Produces an array of fields (columns) in a particular database
###

sub db_fields {
	my ($dbh, $table) = @_;
	$dbh = database_dbh() if ! defined $dbh;
	my $sth = $dbh->prepare("SHOW COLUMNS FROM $PARAMS->{db_prefix}$table") or error_message("Database Error", $dbh->errstr() );
	$sth->execute() or error_message("Database Error", $dbh->errstr());
	my @result = ();
	while (my @x = $sth->fetchrow_array() ) {
		push (@result, $x[0]);
	}
	return \@result;
}

1;

