Mysql database sorting question

[michaelperl]

hi all !

I need some help please

I'm using a database tool for developing and driving dynamic content.
With the tool I use I make queries based on my tables and I set the sorting order of my mysql tables.
Unfortunately the sorting tool does not function.
Is there any way or 3th party script that will enforce my mysql tables to sort on the tablels and columns of my choice?

This is what I could find in the database tool files that seem to be connected to the sorting;
--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Query script:

# Sort rows
If (scalar (@sortby) > 0 and $fileset{DBTYPE} NE 'SQL' or $randomorder) { # SQL databases use their own internal sort, but not necessarily a random one
If ($randomorder) { # Random selection overrides all other sorts
# Random order
Undef my @tempreturns;
$count = 0;
Until ($count > $finalrecord or scalar (@returns) == 0) {
$record = int (rand(scalar (@returns)));
Push (@tempreturns, splice (@returns, $record, 1));
$count ++;
}
@returns = @tempreturns;
}
Elsif ($finalrecord - $firstrecord + 1 >= 0.6 * scalar (@returns)) {
# Inbuilt sort function is faster if the number of rows to return is greater
# than about 60% of the total number of rows
@returns = sort { sortby ($a, $b) } @returns;
}
Else {
# Otherwise, the custom ChopSort is faster
&ChopSort (\@returns, \@sortby);
}
}

MYSQL Script:

# Read in query header
Open (QUERYHEAD, "files/$file/queries/$query.qh") or quitit ("Could not open query header file [datacgi/files/$file/queries/$query.qh].", 1);
@qh = <QUERYHEAD>;
Close QUERYHEAD;
For (0..1) { shift @qh; }
Chomp (@qh);
@sortby = split (/\Q[|]\E/, shift @qh); # Save sorting information for later
Undef %groupby;
%groupby = split (/,| /, pop (@sortby)) if (scalar (@sortby) % 2); # For backward compatibility, assume '[|]group, by, details' may not exist at end of file line
$rawcriteria = shift @qh; # Save criteria string for later
$statsnotneeded = shift @qh; # Save advanced options for later
$randomorder = 0; # True if random order required



# Add sorting information
My $sortcomm = '';
LOOP: for ($count = 0; $count < scalar (@sortby); $count ++) {
If ($count % 2) {
If ($sortby[$count] eq 'random') {
$randomorder = 1;
Last LOOP; # Skip out of loop, as other ordering is pointless
}
Else {
$sortcomm .= ' DESC' if ($sortby[$count] =~ /DEC$/);
}
}
Else {
$sortcomm .= ', ' if ($count); # Don't add comma to start of first field (ie: $count == 0)
$sortcomm .= qq|"$sortby[$count]"|;
}
}
$sqlcomm .= qq| ORDER BY $sortcomm| if (!$randomorder and length ($sortcomm) > 0);

thanks already to any genius around

michael

PS this pieces of script are snippets of the full script, but as far as I could see only this was / is related to the sort function

[chaarmann]

That's a lot of code. Can you please use code tags to make it easier to read? (The #-button in webpage-editor)
Can you please mark the important parts? (or comment-out the unimportant stuff). A small runnable example would be nice. Also a description what went wrong and what output you expected (quote error message).

Without tedious reading through your code, I can give you following answer that may help:
1.) Sort by using "order by" in your SQL. Useful for big tables. For example: "select name, age from table order by name desc". This is the way your code snippets are doing it (see last line in your listing):

$sqlcomm .= qq| ORDER BY $sortcomm| if (!$randomorder and length ($sortcomm) > 0);

2.) Use Schwartzian transformation (or sort-command) to sort the records AFTER you retrieved your answer from SQL. Useful for small tables, reduces database load. Drawback: you have to retieve the whole table even if you only want to display the top-ten.

[michaelperl]

Can you please use code tags to make it easier to read?
Done

Can you please mark the important parts?
If I could understand it I would know what parts are important.

A small runnable example would be nice.
Its just not sorting, for example i have a list thats set to textinc it still shows as:

Horse
Dog
Cat

instead of:
Cat
Dog
Horse

Also a description what went wrong and what output you expected (quote error message).
No error message, just not sorting.
numinc - Not working
numdec - Not working
textinc - Not working
textdec - Not working
random - Working

[chaarmann]

The primary target for analyzing the error is line 33 in the seond listing which adds the "order by" clause to the SQL-command and causes sorting. There the variable $sortcomm should contain the field you want to sort by. $sortcomm is set previously by variable $sortby[$count].

I don't know what variable contains "textinc" which you have given. And also how this variable will influence the @sortby in some code that you have not listed here.
Can you please insert some code between line 18 and 19 of your second listing to print out the values of array @sortby?
I mean, insert following line, run and list the output here?

printf("count=%s, sortby[count]=%s\n", $count, $sortby[$count]);

And while you are at it, please insert also a similar line to show the value of the variable $sqlcomm after line 33

[michaelperl]

I added that line:
printf("count=% s, sortby[count]=%s\n", $count, $sortby[$count]);

Between line 18 and 19 and got:


Internal Server Error
The server encountered an internal error or misconfiguratio n and was unable to complete your request.

Please contact the server administrator, webmaster and inform them of the time the error occurred, and anything you might have done that may have caused the error.

More information about this error may be available in the server error log.


--------------------------------------------------------------------------------

[chaarmann]

The error happens because your output is redirected to the browser. And the browser expects a proper header.
You can do one of the following:

1. Look up the message inside the Apache error log.
2. Provide a header: Insert following line between line 16 and 17:

   print "Content-type: text/html\n\n";

   Then you can see the debug message on the webpage. ("view source" may be needed)
3. Print the debug messages to a file instead:

   open LOGFILE, ">> myLog.txt" or die "Error: cannot open log file!";
   my $message = sprintf("count=%s, sortby[count]=%s\n", $count, $sortby[$count]);
   print LOGFILE "$message";
   close LOGFILE;

[michaelperl]

Hi Chaarmann,

I have added that and got the following:

count=7, sortby[count]=random
Content-type: text/html
 
count=7, sortby[count]=random
Content-type: text/html
 
count=0, sortby[count]=
Content-type: text/html
 
count=0, sortby[count]=
Content-type: text/html
 
count=0, sortby[count]=
Content-type: text/html
 
count=0, sortby[count]=
Content-type: text/html
 
count=0, sortby[count]=
Content-type: text/html
 
count=0, sortby[count]=
Content-type: text/html
 
count=0, sortby[count]=
Content-type: text/html
 
count=0, sortby[count]=
Content-type: text/html
 
count=0, sortby[count]=
Content-type: text/html
 
count=0, sortby[count]=
Content-type: text/html

the list is much longer but all the same with :
count=0, sortby[count]=
Content-type: text/html

The query I tested this with hast the following soring set:

Clients.Content Ranking[|]numdec[|]
Listing.Client[|]numinc[|]
Listing.Name[|]textinc[|]
Listing.MainCat[|]random[|]

Only 'random' seems to work.

Regards

[chaarmann]

Strange ... Why does your listing start with count=7? (Maybe you have not listed the beginning here) And why do you have so many count=0 (Maybe you have more than four lines in your scoring set?)
For debugging purposes, can you please do following and run it again:
1.) Your "scoring set" seems to be the content of file "files/$file/queries/$query.qh". So please only put there the single line "Clients.Conten tRanking[|]numDEC[|]
". Please note that "DEC" must be written in capital letters, as what code line 25 parses for.
2.) If the output is too big, list the beginning lines and skip the end.
3.) Insert after line 33:

print "sqlcomm =$sqlcomm";

[michaelperl]

Hi chaarmann,

Im going to install a copy of the program for testing, it is to hard to test on a life site.

Is there any way we can cumunicate on msn or something like that, maybe i can give you access and you can take a look instead of me trying to follow your instructions and not really knowing what I'm doing :(

Thank you in advance for all your help

[chaarmann]

The listing 2 you provided is nearly a standalone program.
It only assumes the variables $query and $file.
The author of the code isn't a good programmer, because he should have used modularization and comments. That means he should have written the whole code in a "sub" and passing "$query" and "$file" as arguments.
The variables $query and $file ONLY determines the filename, and no global variables from outside influence this piece of code.
So I thought testing it is very easy: just replacing the filename with the fixed name "testForMichael .txt". Then putting your "soring set" (whatever that is. Sore throat?) inside it and run it.

Content of file "testForMichael .txt", the "soring set":

Clients.ContentRanking[|]numdec[|]
Listing.Client[|]numinc[|]
Listing.Name[|]textinc[|]
Listing.MainCat[|]random[|]

It didn't execute.
2 problems:

1. Every line started with a capital letter, so Perl for example couldn't recognize "For" as "for". Also the indentation was screwed up. Did you copy this code inside MS-Word and had autocorrection on? You should NEVER do that. Use Notepad next time (or an appropriate editor).
2. The author used global variables all over which do not NEED to be global. I inserted

   use strict;
   use warnings;

   , so I had to define them all with "my".

Here is the complete code (standalone with debugging) which you can run yourself:

# added for debugging
package michael;
use strict;
use warnings;

# Read in query header 

# replaced for debugging: 
# Open (QUERYHEAD, "files/$file/queries/$query.qh") or quitit ("Could not open query header file [datacgi/files/$file/queries/$query.qh].", 1); 
open (QUERYHEAD, "testForMichael.txt") or die ("Could not open query header file [testForMichael.txt].", 1); 

# added for debugging
my (@qh, @sortby);

@qh = <QUERYHEAD>; 
close QUERYHEAD; 
for (0..1) { shift @qh; } 
chomp (@qh); 
@sortby = split (/\Q[|]\E/, shift @qh); # Save sorting information for later 

# added for debugging
print "hello\n";
print "sortby=" . join(";", @sortby) . "\n";

# replaced for debugging: 
# Undef %groupby; 
my %groupby;

%groupby = split (/,| /, pop (@sortby)) if (scalar (@sortby) % 2); # For backward compatibility, assume '[|]group, by, details' may not exist at end of file line 

# added for debugging
my ($rawcriteria, $statsnotneeded, $randomorder);

$rawcriteria = shift @qh; # Save criteria string for later 
$statsnotneeded = shift @qh; # Save advanced options for later 
$randomorder = 0; # True if random order required 

  
  
# Add sorting information 
my $sortcomm = '';

# added for debugging
my $count;

LOOP: for ($count = 0; $count < scalar (@sortby); $count ++) {
	
	# added for debugging
	printf("count=%s, sortby[count]=%s\n", $count, $sortby[$count]);
	
	if ($count % 2) { 
		if ($sortby[$count] eq 'random') { 
			$randomorder = 1; 
			last LOOP; # Skip out of loop, as other ordering is pointless 
		} 
		else { 
			$sortcomm .= ' DESC' if ($sortby[$count] =~ /DEC$/); 
		} 
	} 
	else { 
		$sortcomm .= ', ' if ($count); # Don't add comma to start of first field (ie: $count == 0) 
		$sortcomm .= qq|"$sortby[$count]"|; 
	} 
} 

# added for debugging
my $sqlcomm;

$sqlcomm .= qq| ORDER BY $sortcomm| if (!$randomorder and length ($sortcomm) > 0); 

# added for debugging
print "sqlcomm =$sqlcomm";

This code produces following output:

> perl testForMichael.pl
hello
sortby=Listing.Name;textinc;
Odd number of elements in hash assignment at testForMichael.pl line 30.
count=0, sortby[count]=Listing.Name
count=1, sortby[count]=textinc
sqlcomm = ORDER BY "Listing.Name"

So what you can see is that it ONLY reads the third line of the file and parses it.
In this example it has done the SQL-sort-clause correctly. (No random sort).
I believe this string "$sqlcomm" would be appended to an sql-command later on in code which is not listed, forming something like "select * from Listing order by Listing.name".

What you should investigate to solve the problem is following (list corresponding code):

• input: the value of the variable "$query" and "$file"
• input: the content of the file ""files/$file/queries/$query.qh"" after you made your inquiry.
• output: what's happening with "$sqlcomm" afterwards, how is it connected to the SQl-inquiry command.

[michaelperl]

Hi chaarmann,

First of all thank you for trying to help me with this issue, I really apriciate it.

You said to :
input: the value of the variable "$query" and "$file"

I assume that you want me to replace $query.qh and $file with the correct name in the script you made (Here is the complete code (standalone with debugging) which you can run yourself)

But then? Im totally lost with; "input: the content of the file ""files/$file/queries/$query.qh"" after you made your inquiry."

I copied your script to a notepad replaced the $query.qh and $file with the correct name but then idk what to do with it :(

As what should i save it? were should i upload it? how should i test it?

I really dont know :(

Thank you

[michaelperl]

Wanted to add one more thing;

I tried pasting your code instead of the current one but that resulted in a Internal Server Error;

im pasting the full sqlsubs.cqi here to maybe make it more simpel:

$dbconnected = 0;     # True if we're connected to an SQL database
$dbcommitrequired = 0;     # SQL Server and Access seem to crash perl interpreter with access violation if an unnecessary commit is made, so we track the necessity

use DBI;
use DBI qw(:sql_types);




## Check access to a specified script or object

sub SQLCheckAccess {

my ($records, $values, $line, $field, $th, $ipindex, $timeindex, $userindex, $passindex, $ipfield, $timefield, $userfield, $passfield, $floodtable, @newdata);
my ($sth, $floodhandle);     # Database statement handles
my $floodwrite = 0;


# Even the admin may accidentally flood, so we check that first

if ($access[5] eq 'on' and $access[6] =~ s/\.th$//) {
	&DBConnect(0);    # Connect to database 
	($file, $table) = split (/\./, $access[6], 2);
	local %fileset = &ReadFileSet($file);

	open (TABLEHEAD, "files/$file/tables/$table.th") or quitit ("Could not open flood control table header [$file/tables/$table.th].", 1);
		@th = <TABLEHEAD>;
	close TABLEHEAD;

	for (0..1) { shift (@th); }
	$primkey = shift @th;
	chomp $primkey;
	LOOP: for ($count = 0; $count < scalar (@th); $count ++) {
		@{$th[$count]} = split (/\Q[|]/, $th[$count]);
		if ($th[$count][0] =~ /^IP_?(?:address)?$/i) {
			$ipindex = $count;
			$newdata[$count] = $ENV{REMOTE_ADDR};
		}
		elsif ($th[$count][0] =~ /^Time$/i) {
			$timeindex = $count;
			$newdata[$timeindex] = time;
		}
		else {
			my $newdata = ($in{$th[$count][0]} or $cookie{$th[$count][0]});
			if ($th[$count][0] eq 'LoginUser' and $newdata eq '') {     # Special handling of 'user' input, to avoid keyword clashes with SQL Server
				$newdata = ($in{user} or $cookie{user});
			}
			$newdata[$count] = &DataIn ($newdata, $newdata, 0, $table, $th[$count]);
		}
	}
	$newdata[$primkey] = 'undefined' if ($newdata[$primkey] eq '');     # Table datasheet may encounter problems if [perhaps phoney] primary key is left blank

	if ($timeindex eq '') {
		quitit ("Incompatible table specified for flood protection [files/$file/tables/$table.th].", 1);
	}


	# Delete all elapsed entries

	my $timelower = time - $access[7];     # Delete all entries with records prior to this time
	$dbh->do(qq|DELETE FROM $fileset{DBPREF}$table WHERE $th[$timeindex][0] < $timelower|) || quitit ('Could not remove obsolete flood protection records. ' . $dbh->errstr, 1);
	$dbcommitrequired = 1;


	# Create condition for SQL flooding check query

	undef my @criteria;
	for ($count = 0; $count < scalar (@th); $count ++) {
		if ($count eq $ipindex) {     # Note deliberate use of eq rather than ==, as $ipindex may be blank ('')
			push (@criteria, qq|$th[$ipindex][0] IN (| . &IPAlternates ($newdata[$ipindex]) . ')');
		}
		elsif ($count != $timeindex) {     # Expired records already removed
			$field = $newdata[$count];
			$field =~ s/'/\\'/g;
			push (@criteria, qq|$th[$count][0] = '$field'|);
		}
	}
	my $criteria = join (' AND ', @criteria);


	# Check for matching flood records

	$sth = $dbh->prepare(qq|SELECT * FROM $fileset{DBPREF}$table WHERE $criteria|) || quitit ('Could not prepare SQL query for selecting flood protection records. ' . $dbh->errstr, 1);
	if ($sth->execute != 0) {

		# Flooding detected

		$sth->finish;
		quitit ('Records indicate that you have already made this request recently.', 1);
	}
	else {
		$sth->finish;
		if ($sth->err) {
			quitit ('Could not retrieve flood protection records. ' . $sth->errstr, 1);
		}

		# Record this access for future flood checks

		$values = '?';
		for (1..$#th) {
			$values .= ', ?';
		}
		$floodhandle = $dbh->prepare(qq|INSERT INTO $fileset{DBPREF}$table (| . &FieldOrder(\@th) . ") VALUES ($values)") || quitit ('Could not prepare SQL statement for recording this request. ' . $dbh->errstr, 1);

		# Save actual writing for after we've checked rest of access protection

		$floodwrite = 1;
		$floodfile = $file;
		$floodtable = $table;     # In case we must drop primary key
	}
}
undef $ipindex;     # Is used again for IP restriction


# Check if it's the admin, if so we let them in immediately

if (exists $in{user} and exists $in{pass} or $access[1] eq 'on' and $access[2] eq 'Administrator Only' or $fileset{COOKIELOGIN} eq 'On' and $cookie{user} ne '' and $cookie{pass} ne '') {
	my (@admins);
	open (ADMINS, 'admin/data/admins.dat') or quitit ("Could not open administrator's file.", 1);
		for (0..1) { push (@admins, <ADMINS>) }
	close ADMINS;
	chomp (@admins);
	$admins[1] = &Decrypt ($admins[1]);
	if ($in{user} eq $admins[0] && $in{pass} eq $admins[1] || $cookie{user} eq $admins[0] && $cookie{pass} eq $admins[1] and $in{user} ne '' && $in{pass} ne '') {
		$cachestatus = 'no';     # Don't want to cache pages that may have admin password in them
		return 1;
	}
	elsif ($access[1] eq 'on' and $access[2] eq 'Administrator Only' and !(exists $in{user} and exists $in{pass})) {     # Print login if we need an admin username and password but don't have them
		&PrintLogin ($object);
	}
	elsif ($access[1] eq 'on' and $access[2] eq 'Administrator Only') {
		open (BREAKLOG, ">>admin/data/breaklog.log");
			filelock (BREAKLOG);
			my $logaddr = (length $ENV{REMOTE_ADDR}) ? $ENV{REMOTE_ADDR} : 'No IP';
			my $loguser = (length $in{user}) ? $in{user} : 'No user';
			my $logobject = (length $object) ? "$in{file}.$object" : 'No object';

			print BREAKLOG &DateString(time) . ' ' . &TimeString(time) . ", $logaddr, $logobject, $loguser\n";
		close BREAKLOG;
		quitit ('Invalid administrator username and/or password. This infringement has been logged.', 1);
	}
}


# Check IP restrictions

if (($access[3] eq 'include' or $access[3] eq 'exclude') and $access[4] =~ s/\.th$//) {     # IP restrictions are enabled and controlled by a table
	&DBConnect(0);    # Connect to database 

	# Explicitly handle situation where user's IP address is unknown
	# (Behaviour: if IP address is unknown, 'include' access is denied but 'exclude' access allowed)

	if ($ENV{REMOTE_ADDR} eq '' and $access[3] eq 'include') {
		quitit ('Access to this area is restricted and your IP address is not specified.', 1);
	}

	($file, $table) = split (/\./, $access[4], 2);
	local %fileset = &ReadFileSet($file);

	open (TABLEHEAD, "files/$file/tables/$table.th") or quitit ("Could not open IP restriction table [$file/tables/$table.th].", 1);
	for (0..2) { <TABLEHEAD>; }
	undef $ipindex;     # May have already been used by flood protection check

	$count = 0;
	LOOP: while ($th = <TABLEHEAD>) {
		@{$th[$count]} = split (/\Q[|]/, $th);
		if ($th[$count][0] =~ /^IP_?(?:address)?$/i) {
			$ipindex = $count;
			last LOOP;
		}
		$count ++;
	}
	close TABLEHEAD;

	if ($ipindex eq '') {
		quitit ("Incompatible table specified for IP restriction [files/$file/tables/$table.th].", 1);
	}
	undef @record;

	$sth = $dbh->prepare(qq|SELECT $th[$ipindex][0] FROM $fileset{DBPREF}$table WHERE $th[$ipindex][0] IN (| . &IPAlternates ($ENV{REMOTE_ADDR}) . ')') || quitit ('Could not prepare SQL query for retrieval of IP restriction addresses. ' . $dbh->errstr, 1);
	$sth->execute;
	$records = ($sth->fetch) ? 1 : 0;
	$sth->finish;

	if ($sth->err) {
		quitit ('Could not retrieve IP restriction addresses. ' . $sth->errstr, 1);
	}
	elsif ($records and $access[3] eq 'exclude') {
		quitit ('You have been prohibited from accessing this area. If you believe this to be a mistake, please contact the site administrator.', 1);
	}
	elsif (!$records and $access[3] eq 'include') {
		quitit ('Access to this area is restricted and your IP address is not authorised.', 1);
	}
}
elsif (($access[3] eq 'include' or $access[3] eq 'exclude') and $access[4] =~ /\.qh$/) {     # IP restrictions are enabled and controlled by a query
	&DBConnect(0);    # Connect to database 

	local %include = %in;
	$access[4] =~ /^(.+?)\.(.+?)\.qh$/ or quitit ("Could not recognise IP restriction query [$access[4]].", 1);
	($file, $query) = ($1, $2);
	local $fileset = &ReadFileSet($file);

	&RunQuery ($file, $query, 0, 0, 1);

	LOOP: foreach $line (@qh) {     # @qh should be around from &RunQuery
		$line =~ /^\w+\.(\w+)$/;
		$field = $1;
		if ($field =~ /^IP(?:address)?$/i) {
			$ipfield = $line;
			last LOOP;
		}
	}
	if ($ipfield eq '') {
		quitit ("Incompatible query specified for IP restriction [$access[4]].", 1);
	}
	LOOP: for ($count = 0; $count < scalar (@returns); $count ++) {
		if (&IPMatch ($ENV{'REMOTE_ADDR'}, $returns[$count]{$ipfield})) {
			if ($access[3] eq 'exclude') {
				quitit ('You have been prohibited from accessing this area. If you believe this to be a mistake, please contact the site administrator.', 1);
			}
			elsif ($access[3] eq 'include') {
				$value = 1;
				last LOOP;
			}
		}
	}
	if ($access[3] eq 'include' and $value == 0) {
		quitit ('Access to this area is restricted and your IP address is not authorised.', 1);
	}
}


# Finally we check for registered user access

if ($access[1] eq 'on' and $access[2] ne '') {
	$cookielogin = 0;     # Global, to indicate whether login details should be passed through forms/URLs, or just through cookie
	my $nonstrictlogin = 0;
	my ($loginuser, $loginpass) = ($in{user}, $in{pass});
	my ($loginsession, $logintoken);
	my ($session, $token, $sessiontime);

	$fileset{SESSIONTABLE} =~ /^(\w+)\.(\w+)$/;
	my ($sessionfile, $sessiontable) = ($1, $2);
	my $sessioncut = time - 60 * $fileset{SESSIONLENGTH};     # oldest allowable session age
	my $tokencut = time - 60 * $fileset{TOKENLENGTH};     # oldest allowable token age

	if ($loginuser eq '' and $loginpass eq '') {
		($loginuser, $loginpass) = ($cookie{user}, $cookie{pass});
		$nonstrictlogin = 1;
	}
	if ($loginuser ne '' and $loginpass eq '' and $fileset{SESSIONS} eq 'On' and $sessiontable ne '') {

		# Attempt to obtain a password from session details

		($loginsession, $logintoken) = ($in{session}, $in{token});
		if ($loginsession eq '' and $logintoken eq '') {
			($loginsession, $logintoken) = ($cookie{session}, $cookie{token});
			$cookielogin = 1;
		}

		if ($loginuser ne '' and ($loginsession ne '' or $logintoken ne '')) {
			&DBConnect(0);    # Connect to database 

			$sth = $dbh->prepare("SELECT Password, Session, Token, Time FROM $fileset{DBPREF}$sessiontable WHERE Username = ? AND ((Session = ? AND Time > ?) OR (Token = ? AND Time > ?)) ORDER BY Time DESC") || quitit ('Could not prepare statement for session check. ' . $dbh->errstr, 1);
			$sth->execute($loginuser, $loginsession, $sessioncut, $logintoken, $tokencut) || quitit ('Could not execute statement for session check. ' . $sth->errstr, 1);
			($loginpass, $session, $token, $sessiontime) = ($sth->fetchrow_array);
			$loginpass = &Decrypt ($loginpass);
			$sth->finish;
		}
		$nonstrictlogin = 1;
	}
	if ($loginuser eq '' or $loginpass eq '') {
		($loginuser, $loginpass) = ($fileset{DEFAULTUSER}, $fileset{DEFAULTPASS});
		($include{user}, $include{pass}) = ($fileset{DEFAULTUSER}, $fileset{DEFAULTPASS});    # ...as if the user logged in that way
		($in{user}, $in{pass}) = ($fileset{DEFAULTUSER}, $fileset{DEFAULTPASS});
		$nonstrictlogin = 1;
	}


	if ($loginuser eq '' or $loginpass eq '') {     # Print login page if login details are still blank
		&PrintLogin ($object);
	}
	if ($loginuser eq $fileset{DEFAULTUSER} and $loginpass eq $fileset{DEFAULTPASS}) {     # Catch user if they have explicitly typed in default account details
		$nonstrictlogin = 1;
	}

	if ($access[2] =~ s/\.th$//) {     # If users come from a table
		&DBConnect(0);    # Connect to database 

		($file, $table) = split (/\./, $access[2], 2);
		local %fileset = &ReadFileSet($file);

		open (TABLEHEAD, "files/$file/tables/$table.th") or quitit ("Could not open registered access table [$file/tables/$table.th].", 1);
		for (0..2) { <TABLEHEAD>; }

		$value = 0;
		$count = 0;

		while ($th = <TABLEHEAD>) {
			@{$th[$count]} = split (/\Q[|]/, $th);
			if ($th[$count][0] =~ /^Username$/i) {
				$userindex = $count;
				last if ($value);
				$value = 1;
			}
			elsif ($th[$count][0] =~ /^Password$/i) {
				$passindex = $count;
				last if ($value);
				$value = 1;
			}
			$count ++;
		}
		if ($userindex eq '' or $passindex eq '') {
			quitit ("Incompatible table specified for registered access [files/$file/tables/$table.th].", 1);
		}
		close TABLEHEAD;

		$sth = $dbh->prepare(qq|SELECT $th[$passindex][0] FROM $fileset{DBPREF}$table WHERE $th[$userindex][0] = ?|) || quitit ('Could not prepare SQL statement for retrieving user information. ' . $dbh->errstr, 1);
		$sth->execute($loginuser) || quitit ('Could not retrieve user information. ' . $sth->errstr, 1);

		$value = 0;
		LOOP: while ($pass = $sth->fetchrow_arrayref) {
			$pass = &DataOut ($$pass[0], $th[$passindex]);
			if ($loginpass eq $pass) {
				$value = 1;
				last LOOP;
			}
		}
		$sth->finish;

		unless ($value) {
			if ($nonstrictlogin) {
				&PrintLogin ($object);
			}
			else {
				quitit ('Invalid username and/or password.', 1);
			}
		}
	}
	elsif ($access[2] =~ /\.qh$/) {     # If users come from a query
		&DBConnect(0);    # Connect to database 

		local %include = %in;
		$access[2] =~ /^(.+?)\.(.+?)\.qh$/ or quitit ('Could not recognise registered access query.', 1);
		($file, $query) = ($1, $2);

		&RunQuery ($file, $query, 0, 0, 1);

		$value = 0;
		foreach $line (@qh) {     # @qh should be around from &RunQuery
			$line =~ /^\w+\.(\w+)$/;
			$field = $1;
			if ($field =~ /^Username$/i) {
				$userfield = $line;
				last if ($value);
				$value = 1;
			}
			elsif ($field =~ /^Password$/i) {
				$passfield = $line;
				last if ($value);
				$value = 1;
			}
		}
		if ($userfield eq '' or $passfield eq '') {
			quitit ('Incompatible query specified for registered access.', 1);
		}

		$value = 0;     # Access defaults to denied
		LOOP: for ($count = 0; $count < scalar (@returns); $count ++) {
			if ($loginuser eq $returns[$count]{$userfield} and $loginpass eq $returns[$count]{$passfield}) {
				$value = 1;     # Access permitted
				last LOOP;
			}
		}

		unless ($value) {
			if ($nonstrictlogin) {
				&PrintLogin ($object);
			}
			else {
				quitit ('Invalid username and/or password.', 1);
			}
		}
	}
	else {
		quitit ('Incompatible object specified for registered access.', 1);
	}

	if ($fileset{SESSIONS} eq 'On' and $sessiontable ne '' and $loginuser ne $fileset{DEFAULTUSER}) {

		# Read in table header

		local %fileset = &ReadFileSet($sessionfile);

		open (TABLEHEAD, "files/$sessionfile/tables/$sessiontable.th") or quitit ("Could not open session control table header [$sessionfile/tables/$sessiontable.th].", 1);
			@th = <TABLEHEAD>;
		close TABLEHEAD;

		for (0..1) { shift (@th); }
		$primkey = shift @th;
		chomp ($primkey);
		my ($sessionindex, $tokenindex, $userindex, $passindex, $timeindex);

		LOOP: for ($count = 0; $count < scalar (@th); $count ++) {
			@{$th[$count]} = split (/\Q[|]/, $th[$count]);
			if ($th[$count][0] =~ /^Session$/i) {
				$sessionindex = $count;
			}
			elsif ($th[$count][0] =~ /^Token$/i) {
				$tokenindex = $count;
			}
			elsif ($th[$count][0] =~ /^Username$/i) {
				$userindex = $count;
			}
			elsif ($th[$count][0] =~ /^Password$/i) {
				$passindex = $count;
			}
			elsif ($th[$count][0] =~ /^Time$/i) {
				$timeindex = $count;
			}
		}

		if ($sessionindex eq '' or $tokenindex eq '' or $userindex eq '' or $passindex eq '' or $timeindex eq '') {
			quitit ("Incompatible table specified for session control [files/$file/tables/$sessiontable.th].", 1);
		}

		if ($loginsession eq $session and $sessiontime > $sessioncut) {     # login was by session
			# Assign new token

			$token = DataIn ('', '[auto]', 0, $sessiontable, \@{$th[$tokenindex]});
			$sth = $dbh->prepare("UPDATE $fileset{DBPREF}$sessiontable SET Token = ? WHERE Session = ?") || quitit ('Could not prepare statement for token update. ' . $dbh->errstr, 1);
			$sth->execute($token, $session) || quitit ('Could not execute statement for token update. ' . $sth->errstr, 1);
			$sth->finish;

			$dbcommitrequired = 1;
		}
		elsif ($logintoken eq $token and $sessiontime > $tokencut) {     # login was by token
			# Assign new token, session and time

			$token = DataIn ('', '[auto]', 0, $sessiontable, \@{$th[$tokenindex]});
			my $oldsession = $session;
			$session = DataIn ('', '[auto]', 0, $sessiontable, \@{$th[$sessionindex]});

			$sth = $dbh->prepare("UPDATE $fileset{DBPREF}$sessiontable SET Session = ?, Token = ?, Time = ? WHERE Session = ?") || quitit ('Could not prepare statement for token update. ' . $dbh->errstr, 1);
			$sth->execute($session, $token, time, $oldsession) || quitit ('Could not execute statement for token update. ' . $sth->errstr, 1);
			$sth->finish;

			$dbcommitrequired = 1;
		}
		else {     # login was by username and password

			# Delete expired session records

			$dbh->do("DELETE FROM $fileset{DBPREF}$sessiontable WHERE Time <= $tokencut AND Time <= $sessioncut") || quitit ('Could not remove expired sessions. ' . $dbh->errstr, 1);


			# Add new session record

			$token = DataIn ('', '[auto]', 0, $sessiontable, \@{$th[$tokenindex]});
			$session = DataIn ('', '[auto]', 0, $sessiontable, \@{$th[$sessionindex]});

			my $addplaceholders = '?';
			for (1..$#th) {
				$addplaceholders .= ', ?';
			}

			undef my @newdata;
			$newdata[$sessionindex] = $session;
			$newdata[$tokenindex] = $token;
			$newdata[$userindex] = $loginuser;
			$newdata[$passindex] = &Encrypt($loginpass);
			$newdata[$timeindex] = time;
			$#newdata = $#th;

			$sth = $dbh->prepare("INSERT INTO $fileset{DBPREF}$sessiontable VALUES ($addplaceholders)") || quitit ('Could not prepare statement for new session creation. ' . $dbh->errstr, 1);
			$sth->execute(@newdata) || quitit ('Could not execute statement for new session creation. ' . $sth->errstr, 1);
			$sth->finish;

			$dbcommitrequired = 1;
		}

		# Make session info available elsewhere

		$session{user} = $loginuser;
		$session{session} = $session;
		$session{token} = $token;

		# Write session cookie if cookies enabled

		if ($fileset{COOKIELOGIN} eq 'On') {
			my $expire = ($fileset{SESSIONLENGTH} > $fileset{TOKENLENGTH}) ? $fileset{SESSIONLENGTH} : $fileset{TOKENLENGTH};     # Suitable expiration time for cookie in minutes
			my $path = "$cgiurl/datacgi";
			$path =~ s/^https?:\/\/.*?\..*?\///i;
			$path = "/$path";
			my $setcookie = new CGI::Cookie (
				-name		=> "$in{file}\_session",
				-value		=> \%session,
				-expires	=> "+${expire}m",
				-path		=> $path
			);
			print "Set-Cookie: $setcookie\n";
		}
	}
}


# Write flood protection record if necessary

if ($floodwrite) {
	for ($count = 0; $count < scalar (@newdata); $count ++) {
		if ($fileset{DBSOFT} =~ /^ODBC/ and length($newdata[$count]) > 255) {
			$floodhandle->bind_param($count + 1, $newdata[$count], DBI::SQL_LONGVARCHAR) or quitit ("Could not bind_param for record insertion." . $floodhandle->errstr, 1);
		}
		else {
			$floodhandle->bind_param($count + 1, $newdata[$count]) or quitit ("Could not bind_param for record insertion." . $floodhandle->errstr, 1);
		}
	}
	$floodhandle->execute;
	$dbcommitrequired = 1;

	# If we couldn't add the record, it's probably because of a violation of the primary key uniqueness. As
	# such, we use a brute force tactic and remove the primary key to try again - flood protection tables
	# have a licence to cheat after all...

	local %fileset = &ReadFileSet($floodfile);

	if ($floodhandle->err) {
		if ($fileset{DBSOFT} =~ /^ODBC/) {
			$dbh->do(qq|ALTER TABLE $fileset{DBPREF}$floodtable DROP CONSTRAINT $fileset{DBPREF}${floodtable}_PK|);
		}
		else {
			$dbh->do(qq|ALTER TABLE $fileset{DBPREF}$floodtable DROP PRIMARY KEY|);
		}
		if ($dbh->err) {     # Something else must be wrong
			quitit ('Could not record request for flood protection. ' .  $dbh->errstr, 1);
		}
		else {
			$floodhandle->execute || quitit ('Could not record request in flood protection table. ' . $floodhandle->errstr, 1);
		}
	}
	$floodhandle->finish;
}

return 1;


# Finds pattern match alternatives for a given IP address

sub IPAlternates {

my $ipaddress = shift @_;
my @components = split (/\./, $ipaddress);

# Each component in the address can be replaced with an asterisk (*) when specifying an IP pattern. As such, there are
# 2**4 = 16 different patterns that the given IP address could match. We use strings of 4 bits to represent each of the
# numbers from 0 to 15. Each string then represents a pattern - 0s indicating asterisks and 1s the actual number usually
# in that position.

undef my @ipalts;
undef my @compalts;
my $bitfield = '';

for (my $count = 0; $count < 16; $count ++) {
	vec ($bitfield, 0, 4) = $count;
	for (0..3) {
		push (@compalts, (vec ($bitfield, $_, 1)) ? $components[$_] : '*');
	}
	push (@ipalts, "'" . join ('.', @compalts) . "'");
	undef @compalts;
}

return join (', ', @ipalts);

}

}




## Read table data

sub SQLReadTable {

&DBConnect(0);    # Connect to database 

my $file = shift @_;
my $table = shift @_;
$firstrecord = shift @_;
$firstrecord = -1 if ($firstrecord eq '');
$finalrecord = shift @_;
$finalrecord = -1 if ($finalrecord eq '');
my $all = shift @_;     # 1 if all records should be returned
my $strictrange = shift @_;     # 1 if record range should not be overridden
my ($seqfield, $count);

open (TABLEHEAD, "files/$file/tables/$table.th") or quitit ("Could not open table header file [datacgi/files/$file/tables/$table.th].", 1);
	@th = <TABLEHEAD>;
close TABLEHEAD;

for (0..1) { shift @th; }

$primkey = shift @th;
chomp ($primkey);

for ($count = 0; $count < scalar (@th); $count ++) {
	@{$th[$count]} = split (/\Q[|]/, $th[$count]);
}


# Validate range of records to return variables (passed in URL)

my $sth = $dbh->prepare(qq|SELECT COUNT(*) FROM $fileset{DBPREF}$table|) || quitit ("Could not prepare calculation of number of records in <i>$table</i> table. " . $dbh->errstr, 1);
$sth->execute || quitit ("Could not execute calculation of number of records in <i>$table</i> table. " . $sth->errstr, 1);
$totalrecords = $sth->fetchrow_array;
$sth->finish;

if ($all) {
	$firstrecord = 0;
	$finalrecord = $totalrecords - 1;
	$navfirstrecord = $firstrecord;
	$navfinalrecord = $finalrecord;
}
else {
	$firstrecord = 0 if ($firstrecord < 0 or $firstrecord > $totalrecords or $firstrecord > $finalrecord);
	$navfirstrecord = $firstrecord;
	$finalrecord = $totalrecords - 1 if ($finalrecord < 0 or $finalrecord < $firstrecord);

	if ($finalrecord - $firstrecord > 99) {
		$finalrecord = $firstrecord + 99;
	}
	$navfinalrecord = $finalrecord;
	$finalrecord = $totalrecords - 1 if ($finalrecord >= $totalrecords and !$strictrange);
}


# Read in datasheet

if ($firstrecord == 0) {     # Read in the number of records we need straight off
	$sth = $dbh->prepare('SELECT ' . &FieldOrder(\@th) . qq| FROM $fileset{DBPREF}$table ORDER BY $th[$primkey][0] ASC|) || quitit ('Could not prepare SQL statement for reading in table record. ' . $dbh->errstr, 1);
	$sth->execute || quitit ("Could not read in particular table record from <i>$table</i> table. " . $sth->errstr, 1);
}
else {
	my $direction = '';
	if ($firstrecord > ($totalrecords - $finalrecord + $firstrecord) / 2) {     # Work backwards to minimise number of wasted records
		$direction = 'DESC';
	}
	else {
		$direction = 'ASC';
	}

	$sth = $dbh->prepare(qq|SELECT $th[$primkey][0] FROM $fileset{DBPREF}$table ORDER BY $th[$primkey][0] $direction|) || quitit ('Could not prepare SQL statement for table reading. ' . $dbh->errstr, 1);
	$sth->execute || quitit ('Could not read in records from <i>$table</i> table. ' . $sth->errstr, 1);

	my (@keys, $key);
	if ($direction eq 'ASC') {

		# Strip away unwanted records

		$count = 0;
		while ($count < $firstrecord and $sth->fetchrow_arrayref) {
			$count ++;
		}


		# Determine primary keys of desired records

		$key = $sth->fetchrow_array;
		until ($count > $finalrecord or $sth->err) {
			push (@keys, $key);
			$count ++;
			$key = $sth->fetchrow_array;
		}
	}
	else {
		# Strip away unwanted records

		$count = $totalrecords - 1;
		while ($count - 1 > $finalrecord and $sth->fetchrow_arrayref) {
			$count --;
		}


		# Determine primary keys of desired records

		$key = $sth->fetchrow_array;
		until ($count < $firstrecord or $sth->err) {
			push (@keys, $key);
			$count --;
			$key = $sth->fetchrow_array;
		}
	}
	$sth->finish;


	# Read in full records

	if (scalar (@keys) > 0) {
		my $keys = '?';
		for (1..$#keys) {
			$keys .= ', ?';
		}
		$sth = $dbh->prepare('SELECT ' . &FieldOrder(\@th) . qq| FROM $fileset{DBPREF}$table WHERE $th[$primkey][0] IN ($keys) ORDER BY $th[$primkey][0] ASC|) || quitit ('Could not prepare SQL statement for reading in table record. ' . $dbh->errstr, 1);
		$sth->execute(@keys) || quitit ('Could not read in records from <i>$table</i> table. ' . $sth->errstr, 1);
	}
}

LOOP: for ($count = 0; $count <= $finalrecord - $firstrecord; $count ++) {
	(@{$td[$count]} = $sth->fetchrow_array) || last LOOP;

	for ($subcount = 0; $subcount < scalar (@th); $subcount ++) {
		$td[$count][$subcount] = &DataOut ($td[$count][$subcount], $th[$subcount]);
	}
}
$sth->finish;
$#td = $finalrecord - $firstrecord;     # Ensure that correct range is returned

}




## Query routine

sub SQLRunQuery {

local $file = shift @_;
local $query = shift @_;
$firstrecord = shift @_;
$firstrecord = -1 if ($firstrecord eq '');
$finalrecord = shift @_;
$finalrecord = -1 if ($finalrecord eq '');
local $all = shift @_;
local $qh;     # Query database handle

&DBConnect(0);    # Connect to database 
require 'libs/querysubs.cgi';

undef %return;


# Read in query header

open (QUERYHEAD, "files/$file/queries/$query.qh") or quitit ("Could not open query header file [datacgi/files/$file/queries/$query.qh].", 1);
	@qh = <QUERYHEAD>;
close QUERYHEAD;

for (0..1) { shift @qh; }
chomp (@qh);

@sortby = split (/\Q[|]\E/, shift @qh);     # Save sorting information for later
undef %groupby;
%groupby = split (/,| /, pop (@sortby)) if (scalar (@sortby) % 2);     # For backward compatibility, assume '[|]group, by, details' may not exist at end of file line

$rawcriteria = shift @qh;     # Save criteria string for later
$statsnotneeded = shift @qh;     # Save advanced options for later
$randomorder = 0;     # True if random order required


# Construct return structure skeleton

LOOP: foreach $key (@qh) {
	if ($key =~ /^(\w+)\.(\w+)$/) {
		if ($1 ne '' and $2 ne '' and $key !~ /^\d+\.\d+$/) {
			$return{$1}{$2} = '';     # The %return hash indicates the fields we must return
		}
	}
}
foreach $table (keys %return) {
	open (TABLEHEAD, "files/$file/tables/$table.th");     # Don't quit if a failed open, just carry on
		@th = <TABLEHEAD>;
	close TABLEHEAD;
	for (0..2) { shift @th; }

	for ($count = 0; $count < scalar (@th); $count ++) {
		@{$th[$count]} = split (/\Q[|]/, $th[$count]);
		if (exists $return{$table}{$th[$count][0]}) {
			$return{$table}{$th[$count][0]} = \@{$th[$count]};     # Save the information from each field for data processing
		}
	}
}


# Prepare criteria
#
# Simplex passes times to SQL databases as integers so as to force its own formatting. The Perl 'time' function is
# treated in SQL WHERE clauses as a useful means to obtain the integer representation of the current time.

my $criteria = $rawcriteria;
$criteria =~ s/\btime\b/time/ge;
$criteria = &CriteriaProcess ($criteria, 1);


# Generate SQL command

undef my %tables;
undef my @fields;     # Fields for SQL query

foreach $table (keys %return) {     # Get participating tables
	foreach $field (keys %{$return{$table}}) {
		if (scalar (keys %groupby) and !exists $groupby{"$table.$field"}) {
			push (@fields, qq|COUNT($fileset{DBPREF}$table.$field) AS "$table.$field"|);     # 'AS' required or hash may have incorrect field names
		}
		else {
			push (@fields, qq|$fileset{DBPREF}$table.$field AS "$table.$field"|);     # 'AS' required or hash will have 'Field' keys rather than 'Table.Field'
		}
	}
}

my $sqlcomm = 'SELECT ' . join (', ', @fields) . ' FROM ';
foreach $key (keys %return) {
	$sqlcomm .= "$fileset{DBPREF}$key, ";
}
$sqlcomm =~ s/, $//;
$sqlcomm .= " WHERE ($criteria)" unless ($criteria eq '');     # We put parentheses around criteria so we can tack on join conditions without disturbing it


# Read in foreign keys and prepare join conditions

my $keep = -1;
undef my @joincomm;
undef my %keys;

open (KEYS, "files/$file/other/keys.dat") or quitit ("Could not open foreign keys file [files/$file/other/keys.dat].", 1);
	while ($key = <KEYS>) {
		chomp $key;
		$keep = -1;     # By default, don't include this relationship in the query

		($keys{many}, $keys{one}) = split (/\Q[|]\E/, $key);

		($table, $field) = split (/\./, $keys{many}, 2);
		$keep ++ if (exists $return{$table});     # Key applies to at least one table in the query, so we record this (must apply to two to be included)

		($table, $field) = split (/\./, $keys{one}, 2);
		$keep ++ if (exists $return{$table});     # Key applies to at least one table in the query

		if ($keep == 1) {
			push (@joincomm, qq|$fileset{DBPREF}$keys{many} = $fileset{DBPREF}$keys{one}|);
		}
	}
close KEYS;

if (scalar (@joincomm) > 0) {
	if ($criteria eq '') {
		$sqlcomm .= ' WHERE ';
	}
	else {
		$sqlcomm .= ' AND ';
	}
	$sqlcomm .= join (' AND ', @joincomm);
}


# Add grouping information

if (scalar (keys %groupby)) {
	$sqlcomm .= ' GROUP BY ';
	foreach $field (keys %groupby) {
		$sqlcomm .= qq|$fileset{DBPREF}$field, |;
	}
	$sqlcomm =~ s/, $//;
}


# Add sorting information

my $sortcomm = '';
LOOP: for ($count = 0; $count < scalar (@sortby); $count ++) {
	if ($count % 2) {
		if ($sortby[$count] eq 'random') {
			$randomorder = 1;
			last LOOP;     # Skip out of loop, as other ordering is pointless
		}
		else {
			$sortcomm .= ' DESC' if ($sortby[$count] =~ /dec$/);
		}
	}
	else {
		$sortcomm .= ', ' if ($count);     # Don't add comma to start of first field (ie: $count == 0)
		$sortcomm .= qq|"$sortby[$count]"|;
	}
}
$sqlcomm .= qq| ORDER BY $sortcomm| if (!$randomorder and length ($sortcomm) > 0);


# Run query (note caching, as some advanced apps tend to repeat queries, and we don't want to prepare them again each the time)

if ($fileset{DBSOFT} =~ /^ODBC/) {     # ODBC may not return no. records on execute, -1 instead, requiring a different process here
	my $recquery = $sqlcomm;
	$recquery =~ s/SELECT .+? FROM/SELECT COUNT(*) FROM/;
	$recquery =~ s/ ORDER BY.+$//;

	my $reccheck = $dbh->prepare($recquery) || quitit ('Could not prepare calculatation of expected number of return records. ' . $dbh->errstr, 1);
	$reccheck->execute || quitit ('Could not calculate expected number of return records. ' . $reccheck->errstr, 1);
	if ($reccheck->err) {
		quitit ('Could not fetch expected number of return records. ' . $reccheck->errstr, 1)
	}

	if (scalar (keys %groupby)) {

		# COUNT(*) gives aggregate for each group in this case, not total number of
		# results. So we use brute force to count return records, with the lack of
		# any more elegant method.

		$totalrecords = 0;
		while ($reccheck->fetch) {
			$totalrecords ++;
		}
	}
	else {
		# COUNT(*) gives total number of results in this case, so we can use
		# something slightly less brute force, but still not ideal.

		($totalrecords) = $reccheck->fetchrow_array;
		$totalrecords = int ($totalrecords);
	}

	$reccheck->finish;

	$qh = $dbh->prepare($sqlcomm) || quitit ('Could not prepare SQL statement for query. ' . $dbh->errstr, 1);
	$qh->execute || quitit ("Could not execute <i>$query</i> query. <br><br>$sqlcomm" . $qh->errstr, 1);
}
else {
	$qh = $dbh->prepare($sqlcomm) || quitit ('Could not prepare SQL statement for query. ' . $dbh->errstr, 1);
	$totalrecords = $qh->execute || quitit ("Could not execute <i>$query</i> query. " . $qh->errstr, 1);
	$totalrecords = int ($totalrecords);     # Get rid of 0E0 if no records returned
}

if ($randomorder or $statsnotneeded ne 'on') {
	@returns = @{$qh->fetchall_arrayref({})};
}


# Wrap up query, determine statistics etc

&QueryEnd;

$qh->finish;

}




## Add a record

sub SQLAddRecord {

my $file = shift @_;
my $table = shift @_;
my ($count, @in);

&DBConnect(0);    # Connect to database 

open (TABLEHEAD, "files/$file/tables/$table.th") or quitit ("Could not open table header file [datacgi/files/$file/tables/$table.th].", 1);
	my @th = <TABLEHEAD>;
close TABLEHEAD;
for (0..1) { shift @th; }
chomp (@th);
my $primkey = shift @th;

for ($count = 0; $count < scalar (@th); $count ++) {
	@{$th[$count]} = split (/\Q[|]\E/, $th[$count]);
}

for ($count = 0; $count < scalar (@th); $count ++) {
	$in[$count] = &DataIn ('', $include{$th[$count][0]}, 0, $table, $th[$count]);
	$include{$th[$count][0]} = &DataOut ($in[$count], $th[$count]);     # Saving to pass back to return page
}


# Check foreign key integrity

&CheckForeignKeys ($file, $table);


# Add record

my $checkrecord = $dbh->prepare(qq|SELECT $th[$primkey][0] FROM $fileset{DBPREF}$table WHERE $th[$primkey][0] = ?|) || quitit ('Could not prepare SQL statement for record existence check. ' . $dbh->errstr, 1);
$checkrecord->execute($in[$primkey]) || quitit ('Could not verify non-existence of record. ' . $checkrecord->errstr, 1);
if ($checkrecord->fetch) {
	quitit ("The $th[$primkey][0] $in[$primkey] already exists. Please enter another value.", 1);
}


my $addplaceholders = '?';
for (1..$#th) {
	$addplaceholders .= ', ?';
}

$sth = $dbh->prepare(qq|INSERT INTO $fileset{DBPREF}$table (| . &FieldOrder(\@th) . ") VALUES ($addplaceholders)") || quitit ('Could not prepare SQL statement for adding record. ' . $dbh->errstr, 1);

for ($count = 0; $count < scalar (@th); $count ++) {
	if ($fileset{DBSOFT} =~ /^ODBC/ and $th[$count][1] eq 'Memo' || $th[$count][2] > 255) {
		$sth->bind_param($count + 1, $in[$count], DBI::SQL_LONGVARCHAR) or quitit ('Could not bind_param for record insertion. ' . $sth->errstr, 1);
	}
	else {
		$sth->bind_param($count + 1, $in[$count]) or quitit ('Could not bind_param for record insertion. ' . $sth->errstr, 1);
	}
}
$sth->execute || quitit ('Could not add record. ' . $sth->errstr, 1);
$sth->finish;
$dbcommitrequired = 1;

}




## Edit a record

sub SQLEditRecord {

my $file = shift @_;
my $table = shift @_;
my $cascade = shift @_;
my ($count, @in);

&DBConnect(0);    # Connect to database 

if ($include{record} eq '') {
	quitit ('No record specified for editing.', 1);
}

open (TABLEHEAD, "files/$file/tables/$table.th") or quitit ("Could not open table header file [datacgi/files/$file/tables/$table.th].", 1);
	my @th = <TABLEHEAD>;
close TABLEHEAD;

for (0..1) { shift @th; }
chomp (@th);
my $primkey = shift @th;

for ($count = 0; $count < scalar (@th); $count ++) {
	@{$th[$count]} = split (/\Q[|]/, $th[$count]);
}

my $getrecord;
if ($fileset{DBSOFT} =~ /^ODBC/) {
	$getrecord = $dbh->prepare('SELECT ' . &FieldOrder(\@th) . qq| FROM $fileset{DBPREF}$table WHERE $th[$primkey][0] = ?|) || quitit ('Could not prepare SQL statement for record selection. ' . $dbh->errstr, 1);
}
else {
	$getrecord = $dbh->prepare('SELECT ' . &FieldOrder(\@th) . qq| FROM $fileset{DBPREF}$table WHERE $th[$primkey][0] = ?|) || quitit ('Could not prepare SQL statement for record selection. ' . $dbh->errstr, 1);;
}

my @record;
$getrecord->execute($include{record}) || quitit ('Could not extract record to edit. ' . $getrecord->errstr, 1);
unless (@record = $getrecord->fetchrow_array) {
	quitit ("Could not find record to edit [$include{record}].", 1);
}

$getrecord->finish;

for ($count = 0; $count < scalar (@th); $count ++) {
	$in[$count] = &DataIn ($record[$count], $include{$th[$count][0]}, 0, $table, $th[$count]);
	$include{$th[$count][0]} = &DataOut ($in[$count], $th[$count]);     # Saving to pass back to return page
}


# Check foreign key integrity

&CheckForeignKeys ($file, $table);


my $editplaceholders = qq|$th[0][0] = ?|;
for (1..$#th) {
	$editplaceholders .= qq|, $th[$_][0] = ?|;
}

my $editrecord = $dbh->prepare(qq|UPDATE $fileset{DBPREF}$table SET $editplaceholders WHERE $th[$primkey][0] = ?|) || quitit ('Could not prepare SQL statement for record edit. ' . $dbh->errstr, 1);

for ($count = 0; $count < scalar (@th); $count ++) {
	if ($fileset{DBSOFT} =~ /^ODBC/ and $th[$count][1] eq 'Memo' || $th[$count][2] > 255) {
		$editrecord->bind_param($count + 1, $in[$count], DBI::SQL_LONGVARCHAR) or quitit ('Could not bind_param for record update. ' . $editrecord->errstr, 1);
	}
	else {
		$editrecord->bind_param($count + 1, $in[$count]) or quitit ('Could not bind_param for record update. ' . $editrecord->errstr, 1);
	}
}

$editrecord->bind_param($count + 1, $include{record}) or quitit ('Could not bind_param for record update. ' . $editrecord->errstr, 1);
$editrecord->execute || quitit ('Could not edit record. ' . $editrecord->errstr, 1);
$editrecord->finish;
$dbcommitrequired = 1;


# Cascade edit extensions
#
# A cascade edit will update all foreign keys referencing this record so that their relationships aren't broken, and
# recursively update foreign keys in records referencing them.
#

if ($cascade and $in[$primkey] ne $record[$primkey]) {     # Only have to update the keys, so ensure that the primary key has actually changed before we bother
	
	# Read in foreign keys

	open (KEYS, "files/$file/other/keys.dat") or quitit ("Could not open foreign keys file [datacgifiles/$file/other/keys.dat].", 1);
		my @keys = <KEYS>;
	close KEYS;
	chomp @keys;

	my @cascadefields;
	for ($count = 0; $count < scalar (@keys); $count ++) {
		($keys[$count]{many}, $keys[$count]{one}) = split (/\Q[|]\E/, $keys[$count]);
		if ($keys[$count]{one} eq "$table.$th[$primkey][0]") {
			push (@cascadefields, $keys[$count]{many});     # Our starting field(s) for cascading
		}
	}

	for ($count = 0; $count < scalar (@cascadefields); $count ++) {     # Cascade should only go one level deep unless primary keys are acting as foreign keys also
		for ($subcount = 0; $subcount < scalar (@keys); $subcount ++) {
			if ($keys[$subcount]{one} eq $cascadefields[$count]) {
				push (@cascadefields, $keys[$subcount]{many});     # Add to end of cascade queue
				splice (@keys, $subcount, 1);
				$subcount --;
			}
		}
	}

	my $editrecord;
	for ($count = 0; $count < scalar (@cascadefields); $count ++) {
		($table, $field) = split (/\./, $cascadefields[$count]);
		$editrecord = $dbh->prepare(qq|UPDATE $fileset{DBPREF}$table SET $field = ? WHERE $field = ?|);
		$editrecord->execute($in[$primkey], $include{record});
		if ($editrecord->err) {
			$editrecord->finish;
			quitit ('Cascade edit through tables failed. ' . $sth->errstr, 1);
		}
		$editrecord->finish;
		$dbcommitrequired = 1;
	}
}

}




## Delete a record

sub SQLDeleteRecord {

$file = shift @_;
$table = shift @_;
$cascade = shift @_;
my ($count, @in, @th, @primkey, @fileindexes);

&DBConnect(0);    # Connect to database 

if ($include{record} eq '') {
	quitit ('No record specified for deletion.', 1);
}

open (TABLEHEAD, "files/$include{file}/tables/$table.th") or quitit ("Could not open table header file [datacgi/files/$include{file}/tables/$table.th].", 1);
	@{$th{$table}} = <TABLEHEAD>;
close TABLEHEAD;

for (0..1) { shift @{$th{$table}}; }
$primkey{$table} = shift @{$th{$table}};
chomp $primkey{$table};

my %fileindexes;
for ($count = 0; $count < scalar (@{$th{$table}}); $count ++) {
	@{$th{$table}[$count]} = split (/\Q[|]/, $th{$table}[$count]);
	if ($th{$table}[$count][1] eq 'File') {
		push (@{$fileindexes{$table}}, $count);
	}
}

my $getrecord = $dbh->prepare('SELECT ' . &FieldOrder(\@{$th{$table}}) . qq| FROM $fileset{DBPREF}$table WHERE $th{$table}[$primkey{$table}][0] = ?|) || quitit ('Could not prepare SQL statement for record selection. ' . $dbh->errstr, 1);
my $numaffected = $getrecord->execute($include{record}) || quitit ('Could not extract record to delete. ' . $getrecord->errstr, 1);
if ($numaffected == 0) {
	quitit ("Could not find record to delete [$include{record}].", 1);
}

my @record = $getrecord->fetchrow_array;
$getrecord->finish;

for ($count = 0; $count < scalar (@{$th{$table}}); $count ++) {
	$include{$th{$table}[$count][0]} = &DataOut ($record[$count], $th{$table}[$count]);     # Saving to pass back to return page
}



# The record has been blanked, so clear out its file upload directory slots...

my ($index, $datafile, @files);
foreach $index (@{$fileindexes{$table}}) {
	if ($record[$index] ne '') {
		opendir (FILEDIR, "files/$file/tables/files/$record[$index]");
			@files = readdir (FILEDIR);
		closedir FILEDIR;
		for (0..1) { shift (@files); }

		foreach $datafile (@files) {
			unlink ("files/$file/tables/files/$record[$index]/$datafile");     # Remove all files in the directory slot
		}
		rmdir ("files/$file/tables/files/$record[$index]");     # Remove the directory slot itself
	}
}

my $deleterecord = $dbh->prepare(qq|DELETE FROM $fileset{DBPREF}$table WHERE $th{$table}[$primkey{$table}][0] = ?|) || quitit ('Could not prepare SQL statement for record deletion. ' . $dbh->errstr, 1);
$deleterecord->execute($include{record}) || quitit ('Could not extract record to delete. ' . $deleterecord->errstr, 1);
$deleterecord->finish;
$dbcommitrequired = 1;


# Cascade delete extensions
#
# A cascade delete will delete all records with foreign keys referencing this record, and recursively delete those
# pointing to them.
#

if ($cascade) {

	# Read in foreign keys

	open (KEYS, "files/$file/other/keys.dat") or quitit ("Could not open foreign keys file [datacgi/files/$file/other/keys.dat].", 1);
		my @keys = <KEYS>;
	close KEYS;
	chomp @keys;

	my (@cascadefields, %coveredkeys);
	for ($count = 0; $count < scalar (@keys); $count ++) {
		($keys[$count]{manyfield}, $keys[$count]{onefield}) = split (/\Q[|]\E/, $keys[$count]);
		($keys[$count]{manytable}, $keys[$count]{manyfield}) = split (/\./, $keys[$count]{manyfield}, 2);
		($keys[$count]{onetable}, $keys[$count]{onefield}) = split (/\./, $keys[$count]{onefield}, 2);

		if ($keys[$count]{onetable} eq $table) {
			push (@cascadefields, $count);     # Our starting field(s) for cascading
			$coveredkeys{"key$count"} = 1;     # Indicates key has been followed (avoid infinite loops when two tables refer to each other)
		}
	}

	for ($count = 0; $count < scalar (@cascadefields); $count ++) {
		for ($subcount = 0; $subcount < scalar (@keys); $subcount ++) {
			if (!exists $coveredkeys{"key$subcount"} and $keys[$subcount]{onetable} eq $keys[$cascadefields[$count]]{manytable}) {
				push (@cascadefields, $subcount);     # Add index of this key to cascade queue
				$coveredkeys{"key$subcount"} = 1;     # Indicates key has been followed (avoid infinite loops when two tables refer to each other)
			}
		}
	}

	my %delkeys;
	push (@{$delkeys{$table}}, $include{record});     # Record primary key of main deleted record

	for ($count = 0; $count < scalar (@cascadefields); $count ++) {
		$table = \$keys[$cascadefields[$count]]{manytable};     # For clarity

		# Read in table header if necessary

		if (!exists $th{$$table}) {
			open (TABLEHEAD, "files/$include{file}/tables/$$table.th") or quitit ("Could not open table header file [datacgi/files/$include{file}/tables/$$table.th].", 1);
				@{$th{$$table}} = <TABLEHEAD>;
			close TABLEHEAD;

			for (0..1) { shift @{$th{$$table}}; }
			$primkey{$$table} = shift @{$th{$$table}};
			chomp $primkey{$$table};

			for ($subcount = 0; $subcount < scalar (@{$th{$$table}}); $subcount ++) {
				@{$th{$$table}[$subcount]} = split (/\Q[|]/, $th{$$table}[$subcount]);
				if ($th{$$table}[$subcount][1] eq 'File') {
					push (@{$fileindexes{$$table}}, $subcount);
				}
			}
		}


		# Delete files

		my $inkeys = '';
		if (scalar (@{$delkeys{$keys[$cascadefields[$count]]{onetable}}}) > 0) {
			$inkeys = '?';
			for (1..scalar (@{$delkeys{$keys[$cascadefields[$count]]{onetable}}}) - 1) {
				$inkeys .= ', ?';
			}
			$sth = $dbh->prepare('SELECT ' . &FieldOrder(\@{$th{$$table}}) . qq| FROM $fileset{DBPREF}$$table WHERE $keys[$cascadefields[$count]]{manyfield} IN ($inkeys)|) || quitit ('Could not prepare SQL statement for file upload slot deletion. ' . $dbh->errstr, 1);
			$sth->execute(@{$delkeys{$keys[$cascadefields[$count]]{onetable}}});

			if ($sth->err) {
				quitit ('Could not delete file upload slots. ' . $sth->errstr, 1);
			}

			while ($record = $sth->fetchrow_arrayref) {
				if ($th{$$table}[$primkey{$$table}][1] =~ /AutoInteger/) {     # Special consideration for keeping leading zeroes in AutoInteger fields
					push (@{$delkeys{$$table}}, sprintf ("%0$th{$$table}[$primkey{$$table}][2]d", $$record[$primkey{$$table}]));
				}
				else {
					push (@{$delkeys{$$table}}, $$record[$primkey{$$table}]);
				}
				foreach $index (@{$fileindexes{$$table}}) {
					if ($$record[$index] ne '') {
						opendir (FILEDIR, "files/$include{file}/tables/files/$$record[$index]");
							@files = readdir (FILEDIR);
						closedir FILEDIR;
						for (0..1) { shift (@files); }

						foreach $file (@files) {
							unlink ("files/$include{file}/tables/files/$$record[$index]/$file");     # Remove all files in the directory slot
						}
						rmdir ("files/$include{file}/tables/files/$$record[$index]");     # Remove the directory slot itself
					}
				}
			}
			$sth->finish;
		}
	}

	my $deletekeys = 0;
	for ($count = 0; $count < scalar (@cascadefields); $count ++) {
		if (scalar (@{$delkeys{$keys[$cascadefields[$count]]{onetable}}}) > 0) {
			$deletekeys = '?';
			for (1..scalar (@{$delkeys{$keys[$cascadefields[$count]]{onetable}}}) - 1) {
				$deletekeys .= ', ?';
			}

			$sth = $dbh->prepare(qq|DELETE FROM $fileset{DBPREF}$keys[$cascadefields[$count]]{manytable} WHERE $keys[$cascadefields[$count]]{manyfield} IN ($deletekeys)|) || quitit ('Could not prepare SQL statement for cascading record deletion. ' . $dbh->errstr, 1);
			$sth->execute(@{$delkeys{$keys[$cascadefields[$count]]{onetable}}});
			if ($sth->err) {
				$sth->finish;
				quitit ('Cascade delete through tables failed. ' . $sth->errstr, 1);
			}
			$sth->finish;
			$dbcommitrequired = 1;
		}
	}
}

}




## Retrieves a specified record from a specified table

# Reads a record into the %record hash

sub SQLGetRecord {

&DBConnect(0);    # Connect to database 

my $file = shift @_;
my $table = shift @_;
my $recordprimkey = shift @_;

open (TABLEHEAD, "files/$file/tables/$table.th") or quitit ("Could not open table header file [datacgi/files/$file/tables/$table.th].", 1);
	@th = <TABLEHEAD>;
close TABLEHEAD;

for (0..1) { shift @th; }
$primkey = shift @th;
chomp $primkey;

for ($count = 0; $count < scalar (@th); $count ++) {
	@{$th[$count]} = split (/\Q[|]/, $th[$count]);
}

undef %record;
my @record;

$sth = $dbh->prepare('SELECT ' . &FieldOrder(\@th) . qq| FROM $fileset{DBPREF}$table WHERE $th[$primkey][0] = ?|) || quitit ('Could not prepare SQL statement for record selection. ' . $dbh->errstr, 1);
$sth->execute($recordprimkey) || quitit ('Could not find specified record. ' . $sth->errstr, 1);
my $temprecord = $sth->fetchrow_arrayref;
unless ($temprecord) {
	quitit ("Could not find specified record [$recordprimkey].", 1);
}
$sth->finish;

for ($count = 0; $count < scalar (@{$temprecord}); $count ++) {     # Put in form $record{'Table.field'}
	$record{"$table.$th[$count][0]"} = &DataOut ($$temprecord[$count], $th[$count]);
}

}




## Sends e-mail to recipients in a system table

sub SQLSendEmailTable {

# Read in table header

&DBConnect(0);    # Connect to database 

open (TABLEHEAD, "files/$file/tables/$table.th") or quitit ("Could not open IP restriction table [$file/tables/$table.th].", 1);
	@th = <TABLEHEAD>;
close TABLEHEAD;
for (0..2) { shift @th; }

LOOP: for ($count = 0; $count < scalar (@th); $count ++) {
	@{$th[$count]} = split (/\Q[|]/, $th[$count]);
	if ($th[$count][0] =~ /^Email$/i) {
		$emailindex = $count;
	}
}
if ($emailindex eq '') {
	quitit ("Incompatible table specified for e-mail address list [files/$file/tables/$table.th].", 1);
}

undef my @emails;
for ($count = 0; $count < scalar (@templates); $count ++) {
	if ($templates[$count]{BccBulk}) {     # Send this message by Bcc bulk method

		# Read in e-mail addresses

		unless (scalar (@emails) > 0) {     # E-mails may already be read in
			@emails = @{$dbh->selectcol_arrayref(qq|SELECT $th[$emailindex][0] FROM $fileset{DBPREF}$table|)};
			quitit ("Could not retrieve e-mail addresses from <i>$table</i> table. " . $dbh->errstr, 1) if ($dbh->err);
		}


		# Ensure single line ending on message

		chomp $templates[$count]{$messagefield};
		$templates[$count]{$messagefield} .= "\n";


		# Prepare Bcc value

		$templates[$count]{$bccfield} .= ', ' if ($templates[$count]{$bccfield} ne '');
		$templates[$count]{$bccfield} .= join (', ', @emails);


		# Construct mail and send
		# (and now would be a good time to fork!)

		# Note subtlety here:
		# 1. If we can obtain file locks, we should be able to fork. $filelock == 1, so !$filelock gives false and the fork will pass this process to the child.
		# 2. If we can't lock files, $filelock == 0, so !$filelock gives true, so !fork need not be evaluated and the system won't attempt to fork.

		if (!$filelock or !fork) {     # Fork off child process if possible, so we can zombie it and not have to sit it out

			if ($filelock and $dbconnected) {     # Don't want child to kill off DB handle
				$dbh->{InactiveDestroy} = 1;
			}

			if ($sendmail) {
				# Prepare Bcc value

				my $headnum = 0;     # Max of 32768 chars in e-mail header, so may need to split Bcc bulk across several e-mails
				$templates[$count]{$bccfield}[$headnum] = $templates[$count]{$bccfield};

				for ($subcount = 0; $subcount < scalar (@emails); $subcount ++) {
					$templates[$count]{$bccfield}[$headnum] .= qq|, $emails[$subcount]|;
					if (length ($templates[$count]{$bccfield}[$headnum]) > 28000) {
						$templates[$count]{$bccfield}[$headnum] =~ s/^, //;
						$headnum ++;
					}
				}
				$templates[$count]{$bccfield}[$headnum] =~ s/^, //;


				# Send

				for ($subcount = 0; $subcount <= $headnum; $subcount ++) {
					open (SENDMAIL, "| $sendmailurl -t") or quitit ('Could not pipe to sendmail program.', 1);
						print SENDMAIL qq|Content-type: text/html\n| if ($templates[$count]{$formatfield} or $fileset{HTMLEMAIL} eq 'On');
						print SENDMAIL qq|From: "$templates[$count]{$fromnamefield}" <$templates[$count]{$fromfield}>\nTo: "$templates[$count]{$tonamefield}" <$templates[$count]{$tofield}>\nCc: $templates[$count]{$ccfield}\nBcc: $templates[$count]{$bccfield}[$subcount]\nSubject: $templates[$count]{$subjectfield}\n\n|;
						print SENDMAIL wrapit ($templates[$count]{$messagefield});
					close SENDMAIL;

					&LogEmail ($templates[$count], $subcount);
				}
			}
			else {
				$templates[$count]{$bccfield} .= ', ' if ($templates[$count]{$bccfield} ne '');
				$templates[$count]{$bccfield} .= join (', ', @emails);

				$smtp->mail($templates[$count]{$fromfield}) or quitit ('SMTP sender command failure.', 1);

				if ($templates[$count]{$tofield} ne '') {
					$smtp->recipient(qq|$templates[$count]{$tofield}|) or quitit ('SMTP recipient command failure.', 1);
				}

				for ($subcount = 0; $subcount < scalar (@emails); $subcount ++) {
					if ($emails[$subcount] ne '') {
						$smtp->recipient($emails[$subcount]) or quitit ('SMTP recipient command failure.', 1);
					}
				}

				$smtp->data();
				$smtp->datasend(qq|Content-type: text/html\n|) if ($templates[$count]{$formatfield} or $fileset{HTMLEMAIL} eq 'On');
				$smtp->datasend(qq|From: "$templates[$count]{$fromnamefield}" <$templates[$count]{$fromfield}>\n|) or quitit ('SMTP From header failure. ' . $smtp->message, 1);
				$smtp->datasend(qq|To: "$templates[$count]{$tonamefield}" <$templates[$count]{$tofield}>\n|) or quitit ('SMTP To header failure. ' . $smtp->message, 1);
				$smtp->datasend("Cc: $templates[$count]{$ccfield}\n") or quitit ('SMTP Cc header failure. ' . $smtp->message, 1);
				$smtp->datasend("Bcc: $templates[$count]{$bccfield}\n") or quitit ('SMTP  Bcc header failure. ' . $smtp->message, 1);
				$smtp->datasend("Subject: $templates[$count]{$subjectfield}\n") or quitit ('SMTP Subject header failure. ' . $smtp->message, 1);
				$smtp->datasend("\n") or quitit ('SMTP data send failure. ' . $smtp->message, 1);
				$smtp->datasend(wrapit ($templates[$count]{$messagefield})) or quitit ('SMTP data send failure. ' . $smtp->message, 1);
				$smtp->dataend();

				&LogEmail ($templates[$count]);
			}
			if ($filelock) {     # Terminate the child if a fork
				exit;
			}
		}
	}
	else {     # Send messages one at a time, as each has customisations

		$sth = $dbh->prepare('SELECT ' . &FieldOrder(\@th) . qq| FROM $fileset{DBPREF}$table|) || quitit ('Could not prepare SQL statement for e-mail address list retrieval. ' . $dbh->errstr, 1);
		$sth->execute || quitit ('Could not retrieve e-mail address list. ' . $sth->errstr, 1);

		if (!$filelock or !fork) {     # Fork off child process if possible, so we can zombie it and not have to sit it out

			if ($filelock and $dbconnected) {     # Don't want child to kill off DB handle
				$dbh->{InactiveDestroy} = 1;
			}

			while (@record = $sth->fetchrow_array) {
				%temptemplate = %{$templates[$count]};
				for ($subcount = 0; $subcount < scalar (@th); $subcount ++) {
					$record[$subcount] = &DataOut ($record[$subcount], $th[$subcount]);
					foreach $key (keys %temptemplate) {
						$temptemplate{$key} =~ s/<!--$key-->/$record[$subcount]/ig unless ($record[$subcount] eq '');
					}
					if ($th[$subcount][0] =~ /^Email$/i) {
						$temptemplate{$bccfield} .= "; $record[$subcount]";
						$temptemplate{$bccfield} =~ s/^; //;
					}
				}

				foreach $key (keys %temptemplate) {

					# Repeat general replacements to catch any nested comment tags

					&ReplaceGlobal (\$temptemplate{$key});
					&ReplaceFormInput (\$temptemplate{$key});
					&ReplaceIncludeInput (\$temptemplate{$key});
					&ReplaceFileSpecific (\$temptemplate{$key}, $file, '');
					&ReplaceCode (\$temptemplate{$key}, 1);
					&ConditionalCheck (\$temptemplate{$key});

					&StripTags (\$temptemplate{$key});
				}


				# Construct mail and send

				if ($sendmail) {
					open (SENDMAIL, "| $sendmailurl -t") or quitit ('Could not pipe to sendmail program.', 1);
						print SENDMAIL qq|Content-type: text/html\n| if ($temptemplate{$formatfield} or $fileset{HTMLEMAIL} eq 'On');
						print SENDMAIL qq|From: "$temptemplate{$fromnamefield}" <$temptemplate{$fromfield}>\nTo: "$temptemplate{$tonamefield}" <$temptemplate{$tofield}>\nCc: $temptemplate{$ccfield}\nBcc: $temptemplate{$bccfield}\nSubject: $temptemplate{$subjectfield}\n\n|;
						print SENDMAIL wrapit ($temptemplate{$messagefield});
					close SENDMAIL;

					&LogEmail (\%temptemplate);
				}
				else {
					my @recipients = (split (/(?:;|,) */, $temptemplate{$tofield}), split (/(?:;|,) */, $temptemplate{$ccfield}), split (/(?:;|,) */, $temptemplate{$bccfield}));
					$smtp->mail($temptemplate{$fromfield}) or quitit ('SMTP sender command failure.', 1);
					$smtp->recipient(@recipients) or quitit ('SMTP recipient command failure.', 1);
					$smtp->data();
					$smtp->datasend(qq|Content-type: text/html\n|) if ($temptemplate{$formatfield} or $fileset{HTMLEMAIL} eq 'On');
					$smtp->datasend(qq|From: "$temptemplate{$fromnamefield}" <$temptemplate{$fromfield}>\n|) or quitit ('SMTP From header failure. ' . $smtp->message, 1);
					$smtp->datasend(qq|To: "$temptemplate{$tonamefield}" <$temptemplate{$tofield}>\n|) or quitit ('SMTP To header failure. ' . $smtp->message, 1);
					$smtp->datasend("Cc: $temptemplate{$ccfield}\n") or quitit ('SMTP Cc header failure. ' . $smtp->message, 1);
					$smtp->datasend("Bcc: $temptemplate{$bccfield}\n") or quitit ('SMTP  Bcc header failure. ' . $smtp->message, 1);
					$smtp->datasend("Subject: $temptemplate{$subjectfield}\n") or quitit ('SMTP Subject header failure. ' . $smtp->message, 1);
					$smtp->datasend("\n") or quitit ('SMTP data send failure. ' . $smtp->message, 1);
					$smtp->datasend(wrapit ($temptemplate{$messagefield})) or quitit ('SMTP data send failure. ' . $smtp->message, 1);
					$smtp->dataend();

					&LogEmail (\%temptemplate);
				}
			}
			$sth->finish;

			if ($filelock) {     # Terminate the child if a fork
				exit;
			}
		}
	}
}

}




## Loads primary keys from the specified table

sub SQLPrimKeys {

my $file = shift @_;
my $table = shift @_;
my $displayfield = shift @_;
my $count = 0;

&DBConnect(0);    # Connect to database 

undef @validvalues;
undef @displayvalues;
open (TABLEHEAD, "files/$file/tables/$table.th") or return 0;
	my (@th) = <TABLEHEAD>;
close TABLEHEAD;

for (0..1) { shift (@th); }
chomp (@th);
$primkey = shift (@th);

my (@primth) = split (/\Q[|]\E/, $th[$primkey]);
undef my @dispth;

LOOP: for ($count = 0; $count < scalar (@th); $count ++) {
	if ($th[$count] =~ /^$displayfield\[/i) {
		@dispth = split (/\Q[|]\E/, $th[$count]);
		last LOOP;
	}
}

if (scalar (@dispth) == 0) {
	@dispth = @primth;
}


# Read in primary keys

my $record = '';     # Holds a primary key value

$sth = $dbh->prepare (qq|SELECT $primth[0], $dispth[0] FROM $fileset{DBPREF}$table ORDER BY $dispth[0]|) || return 0;
$sth->execute || return 0;

while ($record = $sth->fetchrow_arrayref) {
	push (@validvalues, &DataOut ($$record[0], \@primth));
	push (@displayvalues, &DataOut ($$record[1], \@dispth));
}
$sth->finish;

}




## Checks to see that a specified foreign key is valid

sub SQLCheckForeignKey {

# Returns 1 if value found, 0 if not

my $file = shift @_;
my $table = shift @_;
my $checkrecord = shift @_;
my $valid = 0;

&DBConnect(0);    # Connect to database 

open (CHECKTABLEHEAD, "files/$file/tables/$table.th") or return 0;
	my (@tempth) = <CHECKTABLEHEAD>;
close CHECKTABLEHEAD;

for (0..1) { shift (@tempth); }
$primkey = shift (@tempth);
chomp ($primkey);

@tempth = split (/\Q[|]\E/, $tempth[$primkey]);


# Check foreign key validity

my $sqlcomm = qq|SELECT $tempth[0] FROM $fileset{DBPREF}$table WHERE $tempth[0] = ?|;

$sth = $dbh->prepare ($sqlcomm) || quitit ('Could not prepare SQL statement for relationship integrity check. ' . $dbh->errstr, 1);
$valid = $sth->execute($checkrecord) || quitit ('Could not execute SQL statement for relationship integrity check. ' . $dbh->errstr, 1);
$valid = ($sth->fetch) ? 1 : 0;
$sth->finish;

return int ($valid);     # int() required to ensure that "0E0" returned by "execute" when 0 rows affected is interpreted as false

}




## Returns the order of fields for an SQL SELECT statement

sub FieldOrder {
	my $thref = shift @_;
	my $count = 0;
	my @fieldorder;

	for ($count = 0; $count < scalar (@{$thref}); $count ++) {
		push (@fieldorder, qq|$$thref[$count][0]|);
	}
	return join (', ', @fieldorder);
}




## Connect to database

sub DBConnect {

# Allows us to centralise database connection settings

unless ($dbconnected) {
	$autocommit = (shift @_) ? 1 : 0;

	if ($fileset{DBSOFT} eq 'mysql') {     # Some databases don't support transactions and must autocommit
		$autocommit = 1;
	}

	my $dbsoft = $fileset{DBSOFT};
	$dbsoft =~ s/,.*$//g;     # Removes descriptive part from driver name (eg: "ODBC, Microsoft Access" -> "ODBC")

	if ($dbsoft eq 'mysql') {
		$dbh = DBI->connect("dbi:$dbsoft:$fileset{DBNAME}:host=$fileset{DBHOST}", $fileset{DBUSER}, &Decrypt($fileset{DBPASS}), { AutoCommit => $autocommit, RaiseError => 0, LongReadLen => 10000 }) || quitit ('Could not connect to SQL database. ' . DBI->errstr, 1);
	}
	else {
		$dbh = DBI->connect("dbi:$dbsoft:$fileset{DBNAME}", $fileset{DBUSER}, &Decrypt($fileset{DBPASS}), { AutoCommit => $autocommit, RaiseError => 0, LongReadLen => 10000 }) || quitit ('Could not connect to SQL database. ' . DBI->errstr, 1);
	}
	undef $!;

	$dbconnected = 1;
}

}




## Commit changes to database

sub DBCommit {
	$dbh->commit if ($dbconnected and !$autocommit);
}


## Roll back changes to database

sub DBRollback {
	$dbh->rollback if ($dbconnected and !$autocommit);
}


## Disconnect from database

sub DBDisconnect {

	# Allows us to centralise database disconnect process

	&DBCommit;
	$dbh->disconnect if ($dbconnected);
	$dbconnected = 0;
}




## Layer Simplex data types to SQL types

sub CoreDataType {

my $datatype = shift @_;
my $size = shift @_;

if (scalar (keys %lowerlayer) < 1) {

	# MySQL data types

	if ($fileset{DBSOFT} eq 'mysql') {
		%lowerlayer = (
			'Text' => 'VARCHAR',
			'Memo' => 'TEXT',
			'Number' => 'REAL',
			'Integer' => 'INTEGER',
			'Counter' => 'INTEGER',
			'AutoInteger (Seq)' => 'INTEGER',
			'AutoInteger (Ran)' => 'INTEGER',
			'Date' => 'INTEGER',
			'Time' => 'INTEGER',
			'True/False' => 'TINYINT',
			'Email' => 'VARCHAR',
			'URL', => 'VARCHAR',
			'IP Address' => 'VARCHAR',
			'Handle' => 'CHAR',
			'File' => 'CHAR',
			'Password' => 'VARCHAR'
		);
	}

	# Microsoft Access data types

	elsif ($fileset{DBSOFT} eq 'ODBC, Microsoft Access') {
		%lowerlayer = (
			'Text' => 'VARCHAR',
			'Memo' => 'MEMO',
			'Number' => 'REAL',
			'Integer' => 'INTEGER',
			'Counter' => 'INTEGER',
			'AutoInteger (Seq)' => 'INTEGER',
			'AutoInteger (Ran)' => 'INTEGER',
			'Date' => 'INTEGER',
			'Time' => 'INTEGER',
			'True/False' => 'INTEGER',
			'Email' => 'VARCHAR',
			'URL', => 'VARCHAR',
			'IP Address' => 'VARCHAR',
			'Handle' => 'CHAR',
			'File' => 'CHAR',
			'Password' => 'VARCHAR'
		);
	}


	# Microsoft SQL Server data types

	elsif ($fileset{DBSOFT} eq 'ODBC, Microsoft SQL Server') {
		%lowerlayer = (
			'Text' => 'VARCHAR',
			'Memo' => 'TEXT',
			'Number' => 'REAL',
			'Integer' => 'INTEGER',
			'Counter' => 'INTEGER',
			'AutoInteger (Seq)' => 'INTEGER',
			'AutoInteger (Ran)' => 'INTEGER',
			'Date' => 'INTEGER',
			'Time' => 'INTEGER',
			'True/False' => 'INTEGER',
			'Email' => 'VARCHAR',
			'URL', => 'VARCHAR',
			'IP Address' => 'VARCHAR',
			'Handle' => 'CHAR',
			'File' => 'CHAR',
			'Password' => 'VARCHAR'
		);
	}
}


# Returned data type depends on DBMS

if ($size > 255) {     # MySQL and SQL Server (at least) have a limit of 255 characters on a field, besides their special text fields
	return $lowerlayer{'Memo'};
}

# MySQL

if ($fileset{DBSOFT} eq 'mysql') {
	if ($lowerlayer{$datatype} =~ /^(?:REAL|TEXT)$/) {     # Size need not be specified
		return $lowerlayer{$datatype};
	}
	else {
		return "$lowerlayer{$datatype}($size)";
	}
}


# ODBC

else {
	if ($lowerlayer{$datatype} =~ /^(?:REAL|MEMO|TEXT|INTEGER|TINYINT)/) {     # Size need not be specified
		return "$lowerlayer{$datatype}";
	}
	else {
		return "$lowerlayer{$datatype}($size)";
	}	
}

}

return 1;