ODBC interface

Simon Taylor stayl at cs.mu.oz.au
Wed Oct 1 10:53:24 AEST 1997


Hi Fergus,

I can't reproduce the problem that caused the ODBC interface to fall
over just before the 0.7 release, so here it is. You've seen all this
before.

Simon.


A cleaned up version of Mission Critical's ODBC interface.

NEWS
	Document the ODBC interface.

runtime/engine.h
runtime/engine.mod
	Add wrappers around longjmp and setjmp which save and restore 
	some state in engine.c and the Mercury registers.

runtime/mercury_string.h
	Add a macro make_aligned_string_copy to copy a C string
	onto the Mercury heap.

runtime/misc.c
	Avoid a seg-fault when printing out info about the nondet stack
	in a debug grade.

extras/odbc/Mmakefile
extras/odbc/odbc.m
	The interface.

extras/odbc/odbc_test.m
	A simple test case.




Index: NEWS
===================================================================
RCS file: /home/staff/zs/imp/mercury/NEWS,v
retrieving revision 1.75
diff -u -r1.75 NEWS
--- NEWS	1997/09/29 16:23:26	1.75
+++ NEWS	1997/09/30 23:02:48
@@ -96,3 +96,8 @@
   XXX This is not yet enabled by default, though, because it has not
   yet been tested.
 
+* We have added an interface to ODBC databases in extras/odbc. 
+
+  Thanks to the people from Mission Critical, in particular Renaud Paquay,
+  for providing the original version. 
+
Index: runtime/engine.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/engine.h,v
retrieving revision 1.14
diff -u -r1.14 engine.h
--- engine.h	1997/09/05 23:19:55	1.14
+++ engine.h	1997/09/07 02:16:23
@@ -13,9 +13,12 @@
 #ifndef	ENGINE_H
 #define	ENGINE_H
 
+#include <setjmp.h>
+
 #include "std.h"		/* for `bool' */
 #include "mercury_types.h"	/* for `Code *' */
 #include "goto.h"		/* for `Define_entry()' */
+#include "regs.h"		/* for NUM_REAL_REGS */
 
 #define	PROGFLAG	0
 #define	GOTOFLAG	1
@@ -42,6 +45,74 @@
 #define	sregdebug	debugflag[SREGFLAG]
 #define	tracedebug	debugflag[TRACEFLAG]
 #define	detaildebug	debugflag[DETAILFLAG]
+
+	/* 
+	** MR_setjmp and MR_longjmp are wrappers around setjmp and longjmp 
+	** to ensure that
+	**	 call C -> setjmp -> call Mercury -> call C -> longjmp 
+	** works correctly. This is used by the exception handling code for
+	** the ODBC interface.
+	*/ 
+
+typedef struct {
+		jmp_buf *mercury_env;	/* 
+					** used to save MR_engine_jmp_buf 
+					*/
+		jmp_buf env;		/* 
+					** used by calls to setjmp and longjmp 
+					*/
+		Word *saved_succip;
+		Word *saved_hp;
+		Word *saved_sp;
+		Word *saved_curfr;
+		Word *saved_maxfr;
+		Word regs[NUM_REAL_REGS];
+	} MR_jmp_buf;
+
+	/*
+	** MR_setjmp(MR_jmp_buf *env, longjmp_label)
+	**
+	** Save MR_engine_jmp_buf, save the Mercury state, call setjmp(env), 
+	** then fall through.
+	** When setjmp returns via a call to longjmp, control will pass to
+	** longjmp_label.
+	** Note that the Mercury registers must be valid before the call
+	** to MR_setjmp.
+	*/
+#define MR_setjmp(setjmp_env, longjmp_label)				\
+	    do {							\
+		(setjmp_env)->mercury_env = MR_engine_jmp_buf;		\
+		save_regs_to_mem((setjmp_env)->regs);			\
+		(setjmp_env)->saved_succip = succip;			\
+		(setjmp_env)->saved_hp = hp;				\
+		(setjmp_env)->saved_sp = sp;				\
+		(setjmp_env)->saved_curfr = curfr;			\
+		(setjmp_env)->saved_maxfr = maxfr;			\
+		if (setjmp((setjmp_env)->env)) {			\
+			MR_engine_jmp_buf = (setjmp_env)->mercury_env;	\
+			restore_regs_from_mem((setjmp_env)->regs);	\
+			succip = (setjmp_env)->saved_succip;		\
+			hp = (setjmp_env)->saved_hp;			\
+			sp = (setjmp_env)->saved_sp;			\
+			curfr = (setjmp_env)->saved_curfr;		\
+			maxfr = (setjmp_env)->saved_maxfr;		\
+			goto longjmp_label;				\
+		}							\
+	    } while (0)
+
+	/*
+	** MR_longjmp(MR_jmp_buf *env, int return)
+	**
+	** Reset MR_engine_jmp_buf to the value stored in env, restore the
+	** Mercury registers, then call longjmp().
+	*/
+#define MR_longjmp(setjmp_env, ret)	longjmp((setjmp_env)->env, ret)
+
+	/* 
+	** engine_jmp_buf should only be referred to in engine.c
+	** and the MR_setjmp and MR_longjmp macros defined above.
+	*/
+extern	jmp_buf *MR_engine_jmp_buf;
 
 extern	bool	debugflag[];
 
Index: runtime/engine.mod
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/engine.mod,v
retrieving revision 1.43
diff -u -r1.43 engine.mod
--- engine.mod	1997/09/05 23:19:57	1.43
+++ engine.mod	1997/09/20 00:02:39
@@ -31,7 +31,7 @@
 
 bool	debugflag[MAXFLAG];
 
-static jmp_buf *engine_jmp_buf;
+jmp_buf *MR_engine_jmp_buf;
 
 /*---------------------------------------------------------------------------*/
 
@@ -121,25 +121,25 @@
 	jmp_buf		* volatile prev_jmp_buf;
 
 	/*
-	** Preserve the value of engine_jmp_buf on the C stack.
+	** Preserve the value of MR_engine_jmp_buf on the C stack.
 	** This is so "C calls Mercury which calls C which calls Mercury" etc.
 	** will work.
 	*/
 
-	prev_jmp_buf = engine_jmp_buf;
-	engine_jmp_buf = &curr_jmp_buf;
+	prev_jmp_buf = MR_engine_jmp_buf;
+	MR_engine_jmp_buf = &curr_jmp_buf;
 
 	/*
 	** Mark this as the spot to return to.
 	** On return, restore the registers (since longjmp may clobber
-	** them), restore the saved value of engine_jmp_buf, and then
+	** them), restore the saved value of MR_engine_jmp_buf, and then
 	** exit.
 	*/
 
 	if (setjmp(curr_jmp_buf)) {
 		debugmsg0("...caught longjmp\n");
 		restore_registers();
-		engine_jmp_buf = prev_jmp_buf;
+		MR_engine_jmp_buf = prev_jmp_buf;
 		return;
 	}
 
@@ -266,7 +266,7 @@
 	*/
 	save_registers();
 	debugmsg0("longjmping out...\n");
-	longjmp(*engine_jmp_buf, 1);
+	longjmp(*MR_engine_jmp_buf, 1);
 }} /* end call_engine_inner() */
 
 /* with nonlocal gotos, we don't save the previous locations */
@@ -295,7 +295,7 @@
 {
 	save_registers();
 	debugmsg0("longjmping out...\n");
-	longjmp(*engine_jmp_buf, 1);
+	longjmp(*MR_engine_jmp_buf, 1);
 }
 
 static Code *
Index: runtime/mercury_string.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_string.h,v
retrieving revision 1.5
diff -u -r1.5 mercury_string.h
--- mercury_string.h	1997/07/27 15:08:30	1.5
+++ mercury_string.h	1997/08/07 10:43:31
@@ -60,19 +60,34 @@
 */
 #define make_aligned_string(ptr, string) 				\
 	do { 								\
-	    Word make_aligned_string_tmp;				\
-	    char * make_aligned_string_ptr;				\
-									\
 	    if (tag((Word) (string)) != 0) { 				\
-	    	incr_hp_atomic(make_aligned_string_tmp, 		\
+		make_aligned_string_copy((ptr), (string));		\
+	    } else { 							\
+	    	(ptr) = (string);					\
+	    }								\
+	} while(0)
+
+/* void make_aligned_string_copy(ConstString &ptr, const char * string);
+**	Same as make_aligned_string(ptr, string), except that the string
+**	is guaranteed to be copied. This is useful for copying C strings
+**	onto the Mercury heap.
+**
+** BEWARE: this may modify `hp', so it must only be called from
+** places where `hp' is valid.  If calling it from inside a C function,
+** rather than inside Mercury code, you may need to call
+** save/restore_transient_regs().
+*/
+#define make_aligned_string_copy(ptr, string) 				\
+	do {								\
+		Word make_aligned_string_tmp;				\
+		char * make_aligned_string_ptr;				\
+									\
+	  	incr_hp_atomic(make_aligned_string_tmp,			\
 	    	    (strlen(string) + sizeof(Word)) / sizeof(Word));	\
 	    	make_aligned_string_ptr =				\
 		    (char *) make_aligned_string_tmp;			\
 	    	strcpy(make_aligned_string_ptr, (string));		\
 	    	(ptr) = make_aligned_string_ptr;			\
-	    } else { 							\
-	    	(ptr) = (string);					\
-	    }								\
 	} while(0)
 
 /*
Index: runtime/misc.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/misc.c,v
retrieving revision 1.10
diff -u -r1.10 misc.c
--- misc.c	1997/07/27 15:08:32	1.10
+++ misc.c	1997/08/07 10:43:33
@@ -301,9 +301,21 @@
 	printf("ptr 0x%p, offset %3ld words\n",
 		(const void *) s, (long) (Integer) (s - nondetstack_zone->min));
 #else
-	printf("ptr 0x%p, offset %3ld words, procedure %s\n",
-		(const void *) s, (long) (Integer) (s - nondetstack_zone->min),
-		(const char *) s[PREDNM]);
+	if (s > nondetstack_zone->min) {
+		printf("ptr 0x%p, offset %3ld words, procedure %s\n",
+			(const void *) s, 
+			(long) (Integer) (s - nondetstack_zone->min),
+			(const char *) s[PREDNM]);
+	}
+	else {
+		/*
+		** This handles the case where the prevfr of the first frame
+		** is being printed.
+		*/
+		printf("ptr 0x%p, offset %3ld words\n",
+			(const void *) s, 
+			(long) (Integer) (s - nondetstack_zone->min));
+	}
 #endif
 	return;
 }





#-----------------------------------------------------------------------------#
# Copyright (C) 1997 University of Melbourne.
# This file may only be copied under the terms of the GNU General
# Public License - see the file COPYING in the Mercury distribution.
#-----------------------------------------------------------------------------#

# extras/odbc/Mmakefile - Mmake file for building the ODBC interface.

#-----------------------------------------------------------------------------#
# Configuration

# The driver manager.
# Legal values for MODBC_DRIVER are MODBC_IODBC and MODBC_MS.
# Feel free to add more (and handle them in odbc.m).
MODBC_DRIVER=MODBC_IODBC
#MODBC_DRIVER=MODBC_MS

# The database.
# Legal values for MODBC_DB are MODBC_MYSQL and MODBC_SQL_SERVER.
# Feel free to add more (and handle them in odbc.m).
MODBC_DB = MODBC_MYSQL
#MODBC_DB=MODBC_SQL_SERVER

# Pathname for iODBC (only for MODBC_IODBC)
IODBC_DIR=/home/mercury1/stayl/iodbc/iODBC-2.12

# Pathname for the ODBC SDK (only for MODBC_MS)
ODBC_SDK_DIR=/odbcsdk

#-----------------------------------------------------------------------------#

ifeq ($(MODBC_DRIVER),MODBC_MS)
	ODBC_INCL_DIR=$(ODBC_SDK_DIR)/include
	MLLIBS=-lodbc32
else 
	ODBC_LIB_DIR=$(IODBC_DIR)/lib
	ODBC_INCL_DIR=$(IODBC_DIR)
	# note: on a DEC Alpha using OSF1 remove the -ldl.
	MLLIBS=-L$(ODBC_LIB_DIR) -liodbc -ldl
endif

MAIN_TARGET=odbc_test

depend: odbc_test.depend

#-----------------------------------------------------------------------------#

MGNUCFLAGS=-D$(MODBC_DRIVER) -D$(MODBC_DB) -I$(ODBC_INCL_DIR)

#-----------------------------------------------------------------------------#
#-----------------------------------------------------------------------------#



%---------------------------------------------------------------------------%
% Copyright (C) 1997 Mission Critical.
% Copyright (C) 1997 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%
% File: odbc.m
% Authors: Renaud Paquay (rpa at miscrit.be), stayl
% ODBC version: 2.0
%
% The transaction interface used here is described in
%	Kemp, Conway, Harris, Henderson, Ramamohanarao and Somogyi,
% 	"Database transactions in a purely declarative 
%		logic programming language", 
%	Technical Report 96/45, Department of Computer Science, 
% 	University of Melbourne, December 1996,
%	http://www.cs.mu.OZ.AU/publications/tr_db/mu_96_45.ps.gz
%
% This has been tested with MySQL 3.20.19 and iODBC 2.12 under Solaris 2.5,
% and with Microsoft SQL Server 6.5 under Windows NT 4.0 with the GNU-Win32 
% tools beta 17.1.
%
% Notes:
%
% 	Binary data is converted to a string of hexadecimal digits.

%	This requires a compilation grade with conservative garbage 
% 	collection. Any grade containing .gc in its name, such as asm_fast.gc,
%	will do. See the section "Compilation model options" in the Mercury
%	User's Guide for more information.
%
%
% 	The header files distributed with the Microsoft ODBC SDK require
% 	some modification for compilation with gcc. For legal reasons a 
%	patch cannot be included in the Mercury distribution.
%
%	In particular, the line
% 		#define SQL_API		__attribute__ ((stdcall))
%	must be added to sqlext.h.
%
% 	Also some C++ style comments and some typedef conflicts must be 
%	removed from some of the header files. The error messages should 
%	make it obvious which ones. 
%
% To do:
%
%	Improve the interface to the catalog functions.
%
%	Add a nicer interface so the user does not need to manipulate 
%	SQL strings.
% 
%-----------------------------------------------------------------------------%
%
:- module odbc.
%
%-----------------------------------------------------------------------------%

:- interface.

:- import_module io, list.

%-----------------------------------------------------------------------------%

	% Predicates and types for transaction processing.	

:- type odbc__data_source	== string.
:- type odbc__user_name		== string.
:- type odbc__password		== string.

		% A closure to be executed atomically. 
:- type odbc__transaction(T)	== 	pred(T, odbc__state, odbc__state).
:- mode odbc__transaction	::	pred(out, di, uo) is det.

:- type odbc__state.

	% Perform the closure atomically on the given database connection.
	% On error, the transaction is rolled back.
:- pred odbc__transaction(odbc__data_source, odbc__user_name, odbc__password,
		odbc__transaction(T), odbc__result(T), io__state, io__state).
:- mode odbc__transaction(in, in, in, odbc__transaction, out, di, uo) is det.

	% Abort the current transaction, returning the given error message.
:- pred odbc__rollback(string, odbc__state, odbc__state).
:- mode odbc__rollback(in, di, uo) is erroneous.

%-----------------------------------------------------------------------------%

	% Predicates and types for execution of SQL statements.

:- type odbc__row	==	list(odbc__attribute).

:- type odbc__attribute
	--->	null		% SQL NULL value
	;	int(int)	
	;	string(string)
	;	float(float)
	;	time(string).	% Time string: "YYYY-MM-DD hh:mm:ss.mmm"

	% The odbc__state arguments threaded through odbc__execute/4 and
	% odbc__execute/3 enforce the restriction that database activity can
	% only occur within a transaction, since odbc__states are only 
	% available to the closure called by odbc__transaction/5.

	% Execute a command, returning a list of results. 
:- pred odbc__execute(string, list(odbc__row), odbc__state, odbc__state).
:- mode odbc__execute(in, out, di, uo) is det.

	% Execute an SQL statement which doesn't return any results, such
	% as DELETE.
:- pred odbc__execute(string, odbc__state, odbc__state).
:- mode odbc__execute(in, di, uo) is det.

%-----------------------------------------------------------------------------%

	% Predicates and types to get information about database tables.
	% This is very incomplete, it would be nice to be able to get 
	% information about the columns in a table and about privileges 
	% for tables and columns.

:- type odbc__source_desc
	--->	odbc__source_desc(
			odbc__data_source,	% name
			string			% description
		).

:- type odbc__search_pattern
	--->	any
	;	pattern(string).	% _ matches any single character
					% % matches a sequence of characters

	% Information about a table accessible by a transaction.
:- type odbc__table_desc
	--->	odbc__table_desc(
			string,			% table qualifier
			string,			% table owner
			string,			% table name
			string,			% table type
			string,			% description
			list(odbc__attribute)	% data source specific columns
		).

	% Get a list of all the available data sources.
	% Note that iODBC 2.12 doesn't implement this.
:- pred odbc__data_sources(odbc__result(list(odbc__source_desc)), 
		io__state, io__state).
:- mode odbc__data_sources(out, di, uo) is det.

	% odbc__tables(QualifierPattern, OwnerPattern, 
	% 	TableNamePattern, Result)
	% 
	% Get a list of database tables matching the given description.
	% Note that wildcards are not allowed in the QualifierPattern.
	% This is fixed in ODBC 3.0.
:- pred odbc__tables(odbc__search_pattern, odbc__search_pattern,
		odbc__search_pattern, list(odbc__table_desc),
		odbc__state, odbc__state).
:- mode odbc__tables(in, in, in, out, di, uo) is det.

%-----------------------------------------------------------------------------%

	% The following types are used to return status and error 
	% information from ODBC calls.

:- type odbc__result == pair(odbc__status, list(odbc__message)).

:- type odbc__status
	--->	ok
	;	error.

	% The message list returned from a transaction contains all errors 
	% and warnings reported by the driver during the transaction in
	% the order that they were reported.
:- type odbc__result(T) == pair(odbc__status(T), list(odbc__message)).

:- type odbc__status(T)
	--->	ok(T)
	;	error.

:- type odbc__message == pair(odbc__message_type, string).

:- type odbc__message_type
	--->	warning(odbc__warning)
	;	error(odbc__error).

:- type odbc__warning
	--->	disconnect_error
	;	fractional_truncation
	;	general_warning
	;	null_value_in_set_function
	;	privilege_not_revoked
	;	privilege_not_granted
	;	string_data_truncated
	.

:- type odbc__error
	--->	connection_error(odbc__connection_error)
	;	execution_error(odbc__execution_error)
	;	feature_not_implemented
	;	general_error
	;	internal_error
	;	timeout_expired
	;	transaction_error(odbc__transaction_error)
	;	user_requested_rollback
	.

:- type odbc__connection_error
	--->	unable_to_establish
	;	invalid_authorization
	;	connection_name_in_use
	;	nonexistent_connection
	;	connection_rejected_by_server
	;	connection_failure
	;	timeout_expired
	.

:- type odbc__execution_error
	--->	column_already_exists
	;	column_not_found
	;	division_by_zero
	;	general_error
	;	incorrect_count_field
	;	incorrect_derived_table_arity
	;	index_already_exists
	;	index_not_found
	;	integrity_constraint_violation
	;	interval_field_overflow
	;	invalid_cast_specification
	;	invalid_date_time
	;	invalid_escape
	;	invalid_insert_value_list
	;	invalid_schema_name
	;	invalid_use_of_default_parameter
	;	length_mismatch_in_string_data
	;	no_default_for_column
	;	overflow
	;	range_error
	;	restricted_data_type_violation
	;	string_data_length_mismatch
	;	string_data_truncated
	;	syntax_error_or_access_violation
	;	table_or_view_already_exists
	;	table_or_view_not_found
	.

:- type odbc__transaction_error
	--->	rolled_back
	;	still_active
	;	serialization_failure
	;	invalid_state
	.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.

:- import_module assoc_list, int, require, std_util, string.

%-----------------------------------------------------------------------------%

	% We don't actually store anything in the odbc__state, since that
	% would make the exception handling more inconvenient and error-prone.
	% The odbc__state would have to be stored in a global anyway just 
	% before calling longjmp.
	% All the data related to a transaction (ODBC handles, error messages)
	% is stored in the global variables defined below.
:- type odbc__state == unit.

:- pragma c_header_code("

#include ""imp.h""
#include <stdio.h>
#include <stdlib.h>
#include <setjmp.h>
#include <assert.h>

	/*
	** odbc.m allocates memory within may_call_mercury pragma C code, 
	** which is a bit dodgy in non-GC grades. Allowing non-GC grades would
	** require a bit of fairly error-prone code to save/restore the heap 
	** pointer in the right places. When accurate garbage collection is 
	** implemented and a nicer way of allocating heap space from within 
	** C code is available, this should be revisited.
	*/	
#ifndef CONSERVATIVE_GC
#error The OBDC interface requires conservative garbage collection. \\
		Use a compilation grade containing .gc.
#endif /* ! CONSERVATIVE_GC */

#ifdef MODBC_IODBC

#include ""isql.h""
#include ""isqlext.h""
#include ""odbc_funcs.h""
#include ""odbc_types.h""

	/* 
	** iODBC 2.12 doesn't define SQL_NO_TOTAL, so we define it to
	** something random. It must be negative because a positive value 
	** where SQL_NO_TOTAL is returned is the length of the data.
	*/
#ifndef SQL_NO_TOTAL
#define SQL_NO_TOTAL (-1451)
#endif
	/*
	** Again, iODBC 2.12 doesn't define this, so define it to something
	** harmless.
	*/
#ifndef SQL_NO_DATA
#define SQL_NO_DATA SQL_NO_DATA_FOUND
#endif

#endif /* MODBC_IODBC */

#ifdef MODBC_MS

	/*
	** ODBC_VER set to 0x0250 means that this uses only ODBC 2.0 
	** functionality but compiles with the ODBC 3.0 header files.
	*/
#define ODBC_VER 0x0250

#include <windows.h>
#include ""sql.h""
#include ""sqlext.h""
#include ""sqltypes.h""

#endif /* MODBC_MS */

	/*
	** Assert the implication: a => b
	*/
#define MR_ASSERT_IMPLY(a,b)	MR_assert( !(a) || (b) )

	/*
	** All integers get converted to long by the driver, then to Integer.
	** All floats get converted to double by the driver, then to Float.
	*/
typedef long 			MODBC_C_INT;
typedef double			MODBC_C_FLOAT;

	/*
	** Define some wrappers around setjmp and longjmp for exception 
	** handling. We need to use MR_setjmp and MR_longjmp because we'll 
	** be longjmping across C->Mercury calls, so we need to restore 
	** some state in runtime/engine.c.
	** Beware: the Mercury registers must be valid 
	** when odbc_catch is called.
	*/
#define odbc_catch(longjmp_label)					\
			MR_setjmp(&odbc_trans_jmp_buf, longjmp_label)

#define odbc_throw() 	MR_longjmp(&odbc_trans_jmp_buf, 1)

	/* 
	** odbc_trans_jmp_buf stores information saved by odbc_catch (setjmp)
	** to be used by odbc_throw (longjmp) when a database exception is 
	** found.
	*/
static MR_jmp_buf odbc_trans_jmp_buf;

	/*
	** odbc_env_handle is the output of SQLAllocEnv. SQLAllocEnv must
	** be called before attempting to open any connections.	
	*/
static SQLHENV	odbc_env_handle = SQL_NULL_HENV;	

	/* The connection being acted on by the current transaction.	*/
static SQLHDBC	odbc_connection = SQL_NULL_HDBC;

	/* The last return code from an ODBC system call. */
static SQLRETURN odbc_ret_code = SQL_SUCCESS;		

	/* 
	** The list of accumulated warnings and errors for the transaction 
	** in reverse order.
	*/
static Word	odbc_message_list;

static void odbc_transaction_c_code(Word type_info, Word Connection, 
			Word Closure, Word *Results, Word *Status, 
			Word *Msgs, Word IO0, Word *IO);
static bool odbc_check(SQLHENV, SQLHDBC, SQLHSTMT, SQLRETURN);

").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

odbc__transaction(Source, User, Password, Closure, Result) -->
	% We could have separate open and close connection predicates in the 
	% interface, but that would just be more effort for the programmer 
	% for a very minor efficiency gain. The connection time will be 
	% insignificant for even trivial queries.
	odbc__open_connection(Source, User, Password, 
		ConnectStatus - ConnectMessages),
	(
		{ ConnectStatus = ok(Connection) },

		% Do the transaction.
		odbc__transaction_2(Connection, Closure, Data, 
			Status, RevMessages),
		{ list__reverse(RevMessages, TransMessages) },

		odbc__close_connection(Connection,
			CloseStatus - CloseMessages),
		{ list__condense(
			[ConnectMessages, TransMessages, CloseMessages], 
			Messages) },
		( { odbc__ok(Status), CloseStatus = ok } ->
			{ Result = ok(Data) - Messages }
		;
			{ Result = error - Messages }
		)
	;
		{ ConnectStatus = error },
		{ Result = error - ConnectMessages }
	).

:- pred odbc__transaction_2(odbc__connection,
		pred(T, odbc__state, odbc__state), T, 
		int, list(odbc__message), io__state, io__state).  
:- mode odbc__transaction_2(in, pred(out, di, uo) is det, 
		out, out, out, di, uo) is det.

:- pragma c_code(
		odbc__transaction_2(Connection::in, 
			Closure::pred(out, di, uo) is det,
			Results::out, Status::out, Msgs::out,
			IO0::di, IO::uo),
		may_call_mercury,
"
	/*
	** The Mercury registers must be valid at the call to odbc_catch
	** in odbc_transaction_c_code().
	*/
	save_transient_registers();
	odbc_transaction_c_code(TypeInfo_for_T, Connection, Closure, 
			&Results, &Status, &Msgs, IO0, &IO);
	restore_transient_registers();
").


:- pragma c_code(
"
static void 
odbc_transaction_c_code(Word TypeInfo_for_T, Word Connection, 
		Word Closure, Word *Results, Word *Status, 
		Word *Msgs, Word IO0, Word *IO)
{
	Word DB0 = (Word) 0;
	Word DB = (Word) 0;
	SQLRETURN rc;

	restore_transient_registers();

	/*
	** Mercury state to restore on rollback. 
	*/

	odbc_connection = (SQLHDBC) Connection;
	odbc_message_list = list_empty();

	/*
	** Set up a location to jump to on a database exception.
	** The Mercury registers must be valid here.
	*/	
	odbc_catch(transaction_error);

	/*
	** Anything changed between the call to odbc_catch() and the call to
	** MODBC_odbc__do_transaction() must be declared volatile.
	*/

	MODBC_odbc__do_transaction(TypeInfo_for_T, Closure, Results, DB0, &DB);

	/*
	** MR_longjmp() cannot be called after here.
	*/

	rc = SQLTransact(odbc_env_handle, odbc_connection, SQL_COMMIT);

	if (! odbc_check(odbc_env_handle, odbc_connection, 
			SQL_NULL_HSTMT, rc)) {
		goto transaction_error;
	}
	
	*Status = SQL_SUCCESS;

	goto transaction_done;

transaction_error:

	/*
	** Make the database rollback the transaction if it
	** hasn't already. 
	*/

	*Status = odbc_ret_code;

	rc = SQLTransact(odbc_env_handle, odbc_connection, SQL_ROLLBACK);

	odbc_check(odbc_env_handle, odbc_connection, SQL_NULL_HSTMT, rc);

	/* Fall through. */

transaction_done:

	*Msgs = odbc_message_list;
	odbc_message_list = list_empty();
	odbc_connection = SQL_NULL_HDBC;
	odbc_ret_code = SQL_SUCCESS;
	*IO = IO0;

	save_transient_registers();
}
").

%-----------------------------------------------------------------------------%

	% Call the transaction closure.
:- pred odbc__do_transaction(odbc__transaction(T), T,
		odbc__state, odbc__state).
:- mode odbc__do_transaction(odbc__transaction, out, di, uo) is det.

:- pragma export(odbc__do_transaction(odbc__transaction, out, di, uo), 
		"MODBC_odbc__do_transaction").

odbc__do_transaction(Closure, Results) -->
	call(Closure, Results).

%-----------------------------------------------------------------------------%

odbc__rollback(Error) -->
	odbc__add_message(error(user_requested_rollback) - Error),
	odbc__throw.

:- pred odbc__add_message(odbc__message, odbc__state, odbc__state).
:- mode odbc__add_message(in, di, uo) is det.

:- pragma c_code(odbc__add_message(Error::in, DB0::di, DB::uo),
		will_not_call_mercury,
"
{
	odbc_message_list = list_cons(Error, odbc_message_list);
	DB = DB0;
}
").

:- pred odbc__throw(odbc__state, odbc__state).
:- mode odbc__throw(di, uo) is erroneous.

:- pragma c_code(odbc__throw(DB0::di, DB::uo),
		will_not_call_mercury,
"
{
	odbc_ret_code = SQL_ERROR;
	odbc_throw();
	/* DB = DB0; (not reached) */
}
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

	% Predicates and types to manage connections.

:- type odbc__connection.	% A connection to a specific source.

	% Given the data source to connect to and a user name and password,
	% open a connection.
:- pred odbc__open_connection(odbc__data_source, odbc__user_name, 
		odbc__password, odbc__result(odbc__connection), 
		io__state, io__state).
:- mode odbc__open_connection(in, in, in, out, di, uo) is det.

	% Close the connection to the given data source.
:- pred odbc__close_connection(odbc__connection, odbc__result,
		io__state, io__state).
:- mode odbc__close_connection(in, out, di, uo) is det.

%-----------------------------------------------------------------------------%

:- type odbc__connection == c_pointer.

odbc__open_connection(Source, User, Password, Result - Messages) -->
	odbc__do_open_connection(Source, User, Password, Handle,
		ConnectStatus, RevMessages),
	{ list__reverse(RevMessages, Messages) },
	( { odbc__ok(ConnectStatus) } ->
		{ Result = ok(Handle) }
	;
		{ Result = error }
	).

%-----------------------------------------------------------------------------%

:- pred odbc__do_open_connection(string, string, string,
		odbc__connection, int, list(odbc__message), 
		io__state, io__state).
:- mode odbc__do_open_connection(in, in, in, uo, out, out, di, uo) is det.

:- pragma c_code(
		odbc__do_open_connection(Source::in, User::in, Password::in,
			Handle::uo, Status::out, Messages::out,
			IO0::di, IO::uo),
		may_call_mercury, 
"
{
	SQLHDBC connect_handle;


	if (odbc_env_handle == SQL_NULL_HENV) {
		Status = SQLAllocEnv(&odbc_env_handle);
	} else {
		Status = SQL_SUCCESS;
	}

	DEBUG(printf(""SQLAllocEnv status: %d\\n"", (int) Status));

	if (odbc_check(odbc_env_handle, SQL_NULL_HDBC, 
			SQL_NULL_HSTMT, Status)) {

		Status = SQLAllocConnect(odbc_env_handle, &connect_handle);

		DEBUG(printf(""SQLAllocConnect status: %d\\n"", (int) Status));

		if (odbc_check(odbc_env_handle, connect_handle,
				SQL_NULL_HSTMT, Status)) {
			/* Put the connection into manual commit mode */
			Status = SQLSetConnectOption(connect_handle,
				SQL_AUTOCOMMIT, SQL_AUTOCOMMIT_OFF);

			DEBUG(printf(""manual commit status: %d\\n"", 
					(int) Status));

			odbc_check(odbc_env_handle, connect_handle,
				SQL_NULL_HSTMT, Status);
		}
	}

	Status = SQLConnect(connect_handle, 
			(UCHAR *)Source, strlen(Source),
			(UCHAR *)User, strlen(User),
			(UCHAR *)Password, strlen(Password));

	DEBUG(printf(""connect status: %d\\n"", (int) Status));

	odbc_check(odbc_env_handle, connect_handle, SQL_NULL_HSTMT, Status);

	Messages = odbc_message_list;
	odbc_message_list = list_empty();

	Handle = (Word) connect_handle;
	odbc_connection = SQL_NULL_HDBC;
	IO = IO0;
}
").

%-----------------------------------------------------------------------------%

odbc__close_connection(Connection, Result) -->
	odbc__do_close_connection(Connection, Status, RevMessages),
	{ list__reverse(RevMessages, Messages) },
	( { Status = 0 } ->
		{ Result = ok - Messages }
	;
		{ Result = error - Messages }
	).

:- pred odbc__do_close_connection(odbc__connection, int, 
		list(odbc__message), io__state, io__state).
:- mode odbc__do_close_connection(in, out, out, di, uo) is det.

:- pragma c_code(
		odbc__do_close_connection(Handle::in, Status::out,
			Messages::out, IO0::di, IO::uo),
		may_call_mercury,
"

	Status = SQLDisconnect((SQLHDBC) Handle);
	if (odbc_check(odbc_env_handle, (SQLHDBC) Handle, 
			SQL_NULL_HSTMT, Status)) {
		Status = SQLFreeConnect((SQLHDBC) Handle);
		odbc_check(odbc_env_handle, (SQLHDBC) Handle, 
			SQL_NULL_HSTMT, Status);
	}


	Messages = odbc_message_list;
	odbc_message_list = list_empty();

	IO = IO0;
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

odbc__execute(SQLString) -->
	odbc__alloc_statement(Statement0),
	odbc__execute_statement(SQLString, Statement0, Statement),
	odbc__cleanup_statement_check_error(Statement).
	
odbc__execute(SQLString, Results) -->
	odbc__get_result_set(odbc__execute_statement(SQLString), Results).

%-----------------------------------------------------------------------------%

:- pred odbc__get_result_set(pred(odbc__statement, odbc__statement, 
			odbc__state, odbc__state), 
			list(odbc__row), odbc__state, odbc__state).
:- mode odbc__get_result_set(pred(di, uo, di, uo) is det, out, di, uo) is det.

odbc__get_result_set(Execute, Results) -->
	odbc__alloc_statement(Statement0),
	call(Execute, Statement0, Statement1),
	odbc__bind_columns(Statement1, Statement2),
	odbc__get_rows(Results, Statement2, Statement),
	odbc__cleanup_statement_check_error(Statement).

%-----------------------------------------------------------------------------%

	% Get the set of result rows from the statement.
:- pred odbc__get_rows(list(odbc__row), odbc__statement, odbc__statement, 
		odbc__state, odbc__state).
:- mode odbc__get_rows(out, di, uo, di, uo) is det.

odbc__get_rows(Rows, Statement0, Statement) -->
	odbc__get_number_of_columns(NumColumns, Statement0, Statement1),
	odbc__get_rows_2(NumColumns, Rows, Statement1, Statement).

:- pred odbc__get_rows_2(int, list(odbc__row), odbc__statement,
		odbc__statement, odbc__state, odbc__state).
:- mode odbc__get_rows_2(in, out, di, uo, di, uo) is det.

odbc__get_rows_2(NumColumns, Rows, Statement0, Statement) -->
	% Try to fetch a new row.
	odbc__fetch(Statement0, Statement1, Status),
	( { odbc__no_data(Status) } ->
		{ Rows = [] },
		{ Statement = Statement1 }
	;
		odbc__get_attributes(1, NumColumns, Row, 
			Statement1, Statement2),
		odbc__get_rows_2(NumColumns, Rows1, Statement2, Statement),
		{ Rows = [Row | Rows1] }
	).

%-----------------------------------------------------------------------------%

	% Get the values from the current fetched row.
:- pred odbc__get_attributes(int, int, list(odbc__attribute), 
		odbc__statement, odbc__statement,
		odbc__state, odbc__state).
:- mode odbc__get_attributes(in, in, out, di, uo, di, uo) is det.

odbc__get_attributes(CurrCol, NumCols, Row, Statement0, Statement) -->
	( { CurrCol =< NumCols } ->
		{ NextCol is CurrCol + 1 },
		odbc__get_attribute(CurrCol, Attribute, Statement0, Statement1),
		odbc__get_attributes(NextCol, NumCols, Row1, 
			Statement1, Statement),
		{ Row = [Attribute | Row1] }
	;
		{ Row = [] },
		{ Statement = Statement0 }
	).

%-----------------------------------------------------------------------------%

	% Get the value of a column in the current fetched row.
:- pred odbc__get_attribute(int, odbc__attribute, odbc__statement,
		odbc__statement, odbc__state, odbc__state) is det.
:- mode odbc__get_attribute(in, out, di, uo, di, uo) is det.

odbc__get_attribute(NumColumn, Value, Statement0, Statement) -->
	odbc__get_data(NumColumn, Int, Float, String, TypeInt, 
		Statement0, Statement), 
	{ odbc__int_to_attribute_type(TypeInt, Type) },
	(
		{ Type = null },
		{ Value = null }
	;
		{ Type = string },
		{ Value = string(String) }
	;
		{ Type = time },
		{ Value = time(String) }
	; 
		{ Type = int },
		{ Value = int(Int) }
	;
		{ Type = float },
		{ Value = float(Float) }
	).

%-----------------------------------------------------------------------------%

:- type odbc__attribute_type
	--->	int
	;	float
	;	time
	;	string
	;	null.

:- pred odbc__int_to_attribute_type(int, odbc__attribute_type).
:- mode odbc__int_to_attribute_type(in, out) is det.

odbc__int_to_attribute_type(Int, Type) :-
	( odbc__int_to_attribute_type_2(Int, Type1) ->
		Type = Type1
	;
		error("odbc__int_to_attribute_type: invalid type")
	).

	% Keep this in sync with the C enum MODBC_AttrType below.
:- pred odbc__int_to_attribute_type_2(int, odbc__attribute_type).
:- mode odbc__int_to_attribute_type_2(in, out) is semidet.

odbc__int_to_attribute_type_2(0, int).
odbc__int_to_attribute_type_2(1, float).
odbc__int_to_attribute_type_2(2, time).
odbc__int_to_attribute_type_2(3, string).
odbc__int_to_attribute_type_2(4, string).
odbc__int_to_attribute_type_2(5, null).

%-----------------------------------------------------------------------------%

:- type odbc__statement	== c_pointer.

:- pragma c_header_code("

	/*
	** Notes on memory allocation:
	**
	** C data structures (MODBC_Statement and MODBC_Column) are allocated 
	** using newmem/oldmem. 
	**
	** MODBC_Statement contains a statement handle which must be freed 
	** using SQLFreeStmt.
	**
	** Variable length data types are collected in chunks allocated on
	** the Mercury heap using incr_hp_atomic. The chunks are then condensed
	** into memory allocated on the Mercury heap using string__append_list.
	** XXX this may need revisiting when accurate garbage collection 
	** is implemented to make sure the collector can see the data when
	** it is stored within a MODBC_Column.
	**
	** Other data types have a buffer which is allocated once using
	** newmem.
	*/

	/*
	** If the driver can't work out how much data is in a blob in advance,
	** get the data in chunks. The chunk size is fairly arbitrary.
	** MODBC_CHUNK_SIZE must be a multiple of sizeof(Word).
	*/
#define MODBC_CHUNK_WORDS	1024
#define MODBC_CHUNK_SIZE	MODBC_CHUNK_WORDS * sizeof(Word)

typedef enum {
	MODBC_INT	= 0,	/* Word-sized Integer */
	MODBC_FLOAT	= 1,	/* Mercury Float */
	MODBC_TIME	= 2,	/* time and/or date converted to a string */
	MODBC_STRING	= 3,	/* string, or type converted to a string */
	MODBC_VAR_STRING = 4,	/* string with no maximum length */
	MODBC_NULL	= 5
} MODBC_AttrType;

typedef enum { MODBC_BIND_COL, MODBC_GET_DATA } MODBC_BindType;

	/* Information about a column in a result set. */
typedef struct {
		size_t		size;		/* size of allocated buffer */
		MODBC_AttrType	attr_type;
		SWORD		sql_type;	/*
						** the actual type, 	   
						** e.g. SQL_LONG_VAR_CHAR 
						*/
		SWORD		conversion_type;/*
						** the type the data is 
						** being converted into,
						** e.g SQL_C_CHAR
						*/
		SDWORD		value_info;	/* 
						** size of returned data,
						** or SQL_NULL_DATA
						*/
		Word 		*data;
} MODBC_Column;


	/* Information about a result set. */
typedef struct {
		SQLHSTMT	stat_handle;	/* statement handle 	  */
		int		num_columns;	/* columns per row 	  */
		MODBC_Column	*row;		/* 
						** array of columns in 
						** the current row
						*/
		int 		num_rows;	/* number of fetched rows */ 
		MODBC_BindType	binding_type;	/* 
						** are we using SQL_BIND_COL
						** or SQL_GET_DATA
						*/
} MODBC_Statement;

static SQLRETURN odbc_do_cleanup_statement(MODBC_Statement *stat);
static size_t sql_type_to_size(SWORD sql_type, UDWORD cbColDef, 
		SWORD ibScale, SWORD fNullable);
static SWORD attribute_type_to_sql_c_type(MODBC_AttrType AttrType);
static bool is_variable_length_sql_type(SWORD);
void odbc_do_get_data(MODBC_Statement *stat, int column_id);
void odbc_get_data_in_chunks(MODBC_Statement *stat, int column_id);
void odbc_get_data_in_one_go(MODBC_Statement *stat, int column_id);
").

%-----------------------------------------------------------------------------%

:- pred odbc__alloc_statement(odbc__statement, odbc__state, odbc__state).
:- mode odbc__alloc_statement(uo, di, uo) is det.

:- pragma c_code(odbc__alloc_statement(Statement::uo, DB0::di, DB::uo),
		may_call_mercury,
"
{
	MODBC_Statement *statement;
	SQLRETURN rc;


		/* Doing manual deallocation of the statement object. */
	statement = make(MODBC_Statement);
		
	statement->num_columns = 0;
	statement->row = NULL;
	statement->num_rows = 0;
	statement->stat_handle = SQL_NULL_HSTMT;

	rc = SQLAllocStmt(odbc_connection, &(statement->stat_handle));
	if (! odbc_check(odbc_env_handle, odbc_connection,
			statement->stat_handle, rc)) 
	{
		odbc_throw();
		/* not reached */
	}

	MR_assert(statement->stat_handle != SQL_NULL_HSTMT);

	DB = DB0;
	Statement = (Word) statement;

}
").

%-----------------------------------------------------------------------------%

:- pred odbc__execute_statement(string, odbc__statement, odbc__statement,
		odbc__state, odbc__state).
:- mode odbc__execute_statement(in, di, uo, di, uo) is det.

:- pragma c_code(
		odbc__execute_statement(SQLString::in, Statement0::di,
			Statement::uo, DB0::di, DB::uo),
		may_call_mercury,
"
{
	MODBC_Statement *statement = (MODBC_Statement *) Statement0;
	SQLRETURN rc;
	SQLHSTMT stat_handle = statement->stat_handle;

	DEBUG(printf(""executing SQL string: %s\\n"", SQLString));

	rc = SQLPrepare(stat_handle, SQLString, strlen(SQLString));

	if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {

		/*
		** We don't check the return status of this because 
		** the programmer is likely to be more interested 
		** in the earlier error.
		*/
		odbc_do_cleanup_statement(statement);
		odbc_throw();
		/* not reached */
	}

	rc = SQLExecute(stat_handle);
	if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {
		odbc_do_cleanup_statement(statement);
		odbc_throw();
		/* not reached */
	}

	DEBUG(printf(""execution succeeded\\n""));

	Statement = (Word) statement;
	DB = DB0;

}").

%-----------------------------------------------------------------------------%

	%
	% There are two methods to get data back from an ODBC application.
	%
	% One involves binding a buffer to each column using SQLBindCol,
	% then calling SQLFetch repeatedly to read rows into the buffers.
	% The problem with this method is it doesn't work with variable 
	% length data, since if the data doesn't fit into the allocated
	% buffer it gets truncated and there's no way to have a second
	% try with a larger buffer.
	%
	% The other method is to not bind any columns. Instead, after
	% SQLFetch is called to update the cursor, SQLGetData is used
	% on each column to get the data. SQLGetData can be called repeatedly
	% to get all the data if it doesn't fit in the buffer. The problem 
	% with this method is that it requires an extra ODBC function call 
	% for each attribute received, which may have a significant impact 
	% on performance if the database is being accessed over a network.
	% 
	% Hybrid methods are also possible if all the variable length columns
	% come after the fixed length columns in the result set, but that 
	% is probably overkill. (SQLGetData can only be used on columns 
	% after those bound using SQLBindCol).
	%
	% The first method is used if there are no variable length columns,
	% otherwise the second method is used.
	%
:- pred odbc__bind_columns(odbc__statement, odbc__statement,
		odbc__state, odbc__state).
:- mode odbc__bind_columns(di, uo, di, uo) is det.

:- pragma c_code(odbc__bind_columns(Statement0::di, Statement::uo, 
		DB0::di, DB::uo), may_call_mercury,
"{ 
	int 		column_no;
	MODBC_Statement *statement;
	SQLSMALLINT 	num_columns;
	MODBC_Column	*column;
	SQLRETURN 	rc;
	SQLHSTMT 	stat_handle;


	statement = (MODBC_Statement *) Statement0;
	stat_handle = statement->stat_handle;

	/*
	** Retrieve number of columns of statement
	*/
	rc = SQLNumResultCols(stat_handle, &num_columns);
	if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {
		odbc_do_cleanup_statement(statement);
		odbc_throw();
		/* not reached */
	} 
	statement->num_columns = num_columns;

	/* 
	** Allocate an array containing the info for each column.
	** The extra column is because ODBC counts columns starting from 1.
	*/
	statement->row = make_many(MODBC_Column, num_columns + 1);

	/*
	** Use SQLBindCol unless there are columns with no set maximum length.
	*/
	statement->binding_type = MODBC_BIND_COL;

	/*
	** Get information about the result set columns.
	** ODBC counts columns from 1. 
	*/
	for (column_no = 1; column_no <= statement->num_columns; column_no++) {

		char		col_name[1]; 	/* Not looked at */
		SWORD		col_name_len;
		SWORD		col_type;
		UDWORD		pcbColDef;
		SWORD		pibScale;
		SWORD		pfNullable;

		column = &(statement->row[column_no]);
		column->size = 0;
		column->data = NULL;

		/*
		** Retrieve the C type of the column.
		** (SQL type mapped to a conversion type).
		** Create an attribute object with room to store the 
		** attribute value.
		*/
			
		rc = SQLDescribeCol(stat_handle, column_no,
				(UCHAR *) col_name, sizeof(col_name), 
				&col_name_len, &col_type, &pcbColDef, 
				&pibScale, &pfNullable);

		/*
		** SQL_SUCCESS_WITH_INFO means there wasn't
		** enough space for the column name, but we
		** aren't collecting the column name anyway.
		*/
		if (rc != SQL_SUCCESS_WITH_INFO && 
				! odbc_check(odbc_env_handle, odbc_connection,
					stat_handle, rc)) 
		{
			odbc_do_cleanup_statement(statement);
			odbc_throw();
			/* not reached */
		}

		column->sql_type = col_type;
		column->size = sql_type_to_size(col_type, pcbColDef,
				pibScale, pfNullable);

		column->attr_type = sql_type_to_attribute_type(col_type);

		/* Request a conversion into one of the supported types. */
		column->conversion_type =
			attribute_type_to_sql_c_type(column->attr_type);

		DEBUG(printf(""Column %i: size %i - sql_type %i - attr_type %i - conversion_type %i\\n"",
			column_no, column->size, column->sql_type,
			column->attr_type, column->conversion_type));
			
		if (is_variable_length_sql_type(col_type)) {
			statement->binding_type = MODBC_GET_DATA;
		} else {
			/* 
			** Do the buffer allocation once for columns which
			** have a fixed maximum length. 
			*/
			column->data = newmem(column->size);
		}
				
	} /* for */

	if (statement->binding_type == MODBC_BIND_COL) {

		for (column_no = 1; column_no <= statement->num_columns; 
				column_no++) {

			DEBUG(printf(""Binding column %d/%d\\n"", 
					column_no, statement->num_columns));
			column = &(statement->row[column_no]);

			rc = SQLBindCol(stat_handle, column_no,
					column->conversion_type, 
					(SQLPOINTER) column->data,
					column->size, &(column->value_info));
			if (! odbc_check(odbc_env_handle, odbc_connection, 
					stat_handle, rc)) 
			{
				odbc_do_cleanup_statement(statement);
				odbc_throw();
				/* not reached */
			}
		}
	}

	Statement = (Word) statement;
	DB = DB0;

} /* odbc__bind_columns */
").

%-----------------------------------------------------------------------------%

	% Fetch the next row of the current statement.
:- pred odbc__fetch(odbc__statement, odbc__statement,
		int, odbc__state, odbc__state).
:- mode odbc__fetch(di, uo, out, di, uo) is det.

:- pragma c_code(odbc__fetch(Statement0::di, Statement::uo,
		Status::out, DB0::di, DB::uo),
		may_call_mercury,
"{
	MODBC_Statement *stat;

	stat = (MODBC_Statement *) Statement0;

	MR_assert(stat != NULL);

	if (stat->num_rows == 0 ) {
		DEBUG(printf(""Fetching rows...\\n""));
	}

	/* Fetching new row */
	Status = SQLFetch(stat->stat_handle);

	if (Status != SQL_NO_DATA_FOUND && 
			! odbc_check(odbc_env_handle, odbc_connection, 
				stat->stat_handle, Status))
	{
		odbc_do_cleanup_statement(stat);
		odbc_throw();
		/* not reached */
	}

	/* Update number of rows fetched */
	if (Status == SQL_SUCCESS) {
		stat->num_rows++;
	}

	if (Status == SQL_NO_DATA_FOUND) {
		DEBUG(printf(""Fetched %d rows\\n"", stat->num_rows));
	}

	Statement = (Word) stat;
	DB = DB0;

}").

%-----------------------------------------------------------------------------%

:- pred odbc__get_number_of_columns(int, odbc__statement, odbc__statement, 
		odbc__state, odbc__state).
:- mode odbc__get_number_of_columns(out, di, uo, di, uo) is det.

:- pragma c_code(odbc__get_number_of_columns(NumColumns::out, Statement0::di,
		Statement::uo, DB0::di, DB::uo), 
		will_not_call_mercury,
"{
	MODBC_Statement * stat;

	stat = (MODBC_Statement *) Statement0;

	MR_assert(stat != NULL);
		
	NumColumns = stat->num_columns;
	DB = DB0;
	Statement = Statement0;
}").

%-----------------------------------------------------------------------------%

:- pred odbc__get_data(int, int, float, string, int, odbc__statement, 
		odbc__statement, odbc__state, odbc__state).
:- mode odbc__get_data(in, out, out, out, out, di, uo, di, uo) is det.

:- pragma c_code(odbc__get_data(Column::in, Int::out, Flt::out, Str::out, 
		Type::out, Statement0::di, Statement::uo, DB0::di, DB::uo),
		may_call_mercury,
"{

	MODBC_Statement *stat;
	MODBC_Column 	*col;
	SQLRETURN 	rc;
	SDWORD		column_info;

	stat = (MODBC_Statement *) Statement0;

	MR_assert(stat != NULL);
	MR_assert(stat->row != NULL);

	DEBUG(printf(""Getting column %i\n"", (int) Column));

	if (stat->binding_type == MODBC_GET_DATA) {

		/* Slurp up the data for this column. */ 
		odbc_do_get_data(stat, Column);
	}

	col = &(stat->row[Column]);

	if (col->value_info == SQL_NULL_DATA) {
		Type = MODBC_NULL;
	} else {
		Type = col->attr_type;
	}

	switch ((int) Type) {

	    case MODBC_NULL:
		break;

	    case MODBC_INT: {

		MODBC_C_INT data = *(MODBC_C_INT *)(col->data);

		Int = (Integer) data;

		DEBUG(printf(""got integer %ld\\n"", (long) Int));

			/* Check for overflow */
		if (Int != data) {
			Word overflow_message;
			MODBC_overflow_message(&overflow_message);
			odbc_message_list =
				list_cons(overflow_message, odbc_message_list);
			odbc_do_cleanup_statement(stat);
			odbc_throw();
		}
		break;
	    }

	    case MODBC_FLOAT:

		Flt = (Float) *(MODBC_C_FLOAT *)(col->data);

		DEBUG(printf(""got float %f\\n"", Flt));

		break;

	    case MODBC_STRING:
	    case MODBC_TIME:

		MR_assert(col->data);
		make_aligned_string_copy(Str, (char *) col->data);

		DEBUG(printf(""got string %s\\n"", (char *) Str));

		break;
	
	    case MODBC_VAR_STRING:
		/*
		** The data was allocated on the Mercury heap, 
		** get it then kill the pointer so it can be GC'ed.
		*/
		make_aligned_string(Str, (char *) col->data);

		DEBUG(printf(""got var string %s\\n"", (char *) col->data));

		col->data = NULL;

		/* As far as Mercury is concerned it's an ordinary string */
		Type = MODBC_STRING;
		break;

	    default:
		fatal_error(
			""odbc.m: invalid attribute type in odbc__get_data"");
		break;
	} /* end switch (Type) */

	Statement = (Word) stat;
	DB = DB0;

} /* end odbc__get_data() */
").

:- pragma c_code("

void
odbc_do_get_data(MODBC_Statement *stat, int column_id)
{
	MODBC_Column 	*column;
	SQLRETURN 	rc;
	SDWORD		column_info;
	char 		dummy_buffer[1]; /*
					 ** Room for the NUL termination 
					 ** byte and nothing else.
					 */

	column = &(stat->row[column_id]);
	if (column->attr_type == MODBC_VAR_STRING) {

		/* Just get the length first time through. */
		rc = SQLGetData(stat->stat_handle, column_id,
				column->conversion_type, dummy_buffer, 
				1, &(column->value_info));

		/*
		** SQL_SUCCESS_WITH_INFO is expected here, since
		** we didn't allocate any space for the data, so
		** don't collect the ""data truncated"" message.
		*/
		if (rc != SQL_SUCCESS_WITH_INFO &&
				! odbc_check(odbc_env_handle, 
					odbc_connection, 
					stat->stat_handle, rc)) 
		{
			odbc_do_cleanup_statement(stat);	
			odbc_throw();
		}

		if (column->value_info == SQL_NULL_DATA) {
			/* 
			** The column is NULL, so there is no data to get.
			*/
			return;
		} else if (column->value_info == SQL_NO_TOTAL) {
			/*
			** The driver couldn't work out the length
			** in advance, so get the data in chunks of
			** some arbitrary size, and append the chunks
			** together.
			** This method must be used with MODBC_IODBC,
			** since iODBC-2.12 uses a different interpretation
			** of the ODBC standard to Microsoft, for which
			** the length returned by the first call to SQLGetData
			** above is the minimun of the buffer length and the 
			** length of the available data, rather than the 
			** total length of data available.
			*/
			odbc_get_data_in_chunks(stat, column_id);
		} else { 
			Word data;

			/* 
			** column->value_info == length of data 
			*/
			column->size = column->value_info + 1;
			incr_hp_atomic(LVALUE_CAST(Word, column->data), 
				(column->size + sizeof(Word)) / sizeof(Word));
			odbc_get_data_in_one_go(stat, column_id);
		}
	} else {
		/* 
		** It's a fixed length column, so we can 
		** get the lot in one go.
		*/
		odbc_get_data_in_one_go(stat, column_id);
	}
}

void 
odbc_get_data_in_one_go(MODBC_Statement *stat, int column_id)
{
	MODBC_Column 	*col;
	SQLRETURN 	rc;

	DEBUG(printf(""getting column %i in one go\n"", column_id));

	col = &(stat->row[column_id]);

	rc = SQLGetData(stat->stat_handle, column_id, col->conversion_type, 
			(SQLPOINTER) col->data, col->size, &(col->value_info));

	if (! odbc_check(odbc_env_handle, odbc_connection, 
			stat->stat_handle, rc)) 
	{
		odbc_do_cleanup_statement(stat);	
		odbc_throw();
	}
}

void 
odbc_get_data_in_chunks(MODBC_Statement *stat, int column_id)
{
	MODBC_Column 	*col;
	SQLRETURN 	rc;
	Word		this_bit;
	Word 		chunk_list;
	String		result;

	DEBUG(printf(""getting column %i in chunks\n"", column_id));

	chunk_list = list_empty();

	col = &(stat->row[column_id]);

	rc = SQL_SUCCESS_WITH_INFO;

	incr_hp_atomic(this_bit, MODBC_CHUNK_WORDS);

		/*
		** Keep collecting chunks until we run out.
		*/
	while (rc == SQL_SUCCESS_WITH_INFO) {

		rc = SQLGetData(stat->stat_handle, column_id, 
				col->conversion_type, (SQLPOINTER) this_bit,
				MODBC_CHUNK_SIZE - 1, &(col->value_info));
	
		if (rc == SQL_NO_DATA_FOUND) {
			break;
		}

		if (rc != SQL_SUCCESS_WITH_INFO &&
				! odbc_check(odbc_env_handle, odbc_connection, 
					stat->stat_handle, rc)) 
		{
			odbc_do_cleanup_statement(stat);	
			odbc_throw();
		}

		chunk_list = list_cons(this_bit, chunk_list);
		incr_hp_atomic(this_bit, MODBC_CHUNK_WORDS);
	}

	MODBC_odbc_condense_chunks(chunk_list, &result);
	col->data = (Word *) result;
}
").

:- pred odbc__overflow_message(odbc__message).
:- mode odbc__overflow_message(out) is det.

:- pragma export(odbc__overflow_message(out), 
		"MODBC_overflow_message").

odbc__overflow_message(Error) :-
	Error = error(execution_error(overflow))
		- "[Mercury][odbc.m]Integer overflow detected in result set. Integers must be no larger than a word.".

:- pred odbc__condense_chunks(list(string), string).
:- mode odbc__condense_chunks(in, out) is det.

:- pragma export(odbc__condense_chunks(in, out), "MODBC_odbc_condense_chunks").

odbc__condense_chunks(RevChunks, String) :-
	list__reverse(RevChunks, Chunks),
	string__append_list(Chunks, String).

%-----------------------------------------------------------------------------%

:- pred odbc__cleanup_statement_check_error(odbc__statement,
		odbc__state, odbc__state).
:- mode odbc__cleanup_statement_check_error(di, di, uo) is det.

:- pragma c_code(
	odbc__cleanup_statement_check_error(Statement::di, DB0::di, DB::uo),
	may_call_mercury,
"{
	MODBC_Statement *stat;
	SQLRETURN rc;

	stat = (MODBC_Statement *) Statement;

	rc = odbc_do_cleanup_statement(stat);
	if (! odbc_check(odbc_env_handle, odbc_connection, 
			SQL_NULL_HSTMT, rc)) 
	{
		odbc_throw();
	}	
	DB = DB0;
}").

:- pragma c_code("

static SQLRETURN
odbc_do_cleanup_statement(MODBC_Statement *stat)
{
	int i;
	SQLRETURN rc;

	if (stat != NULL) {
		DEBUG(printf(""cleaning up statement\\n""));
		if (stat->row != NULL) {
		    for (i = 1; i <= stat->num_columns; i++) {
			    /*
			    ** Variable length types are allocated directly
			    ** onto the Mercury heap, so don't free them here. 
			    */
			if (! is_variable_length_sql_type(
				    	stat->row[i].sql_type)) 
			{
				oldmem(stat->row[i].data);
			}
		    }
		    oldmem(stat->row);
		}
		rc = SQLFreeStmt(stat->stat_handle, SQL_DROP);
		oldmem(stat);
		return rc;
	} else {
		return SQL_SUCCESS;
	}
}").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- pragma c_code("

/*
**  Map an ODBC SQL type to a supported attribute type.
**  Currently, supported attribute types are minimal,
**  but this function will allow us to ask ODBC to make
**  convertion from SQL types to supported types.
**  Binary types are currently converted to strings. 
*/
static MODBC_AttrType 
sql_type_to_attribute_type(SWORD sql_type)
{
	switch (sql_type) {
		case SQL_BIGINT:		return MODBC_STRING;
		case SQL_BINARY:		return MODBC_STRING;
		case SQL_BIT:			return MODBC_STRING;
		case SQL_CHAR:			return MODBC_STRING;
		case SQL_DATE:			return MODBC_TIME;
		case SQL_DECIMAL:		return MODBC_STRING; /*?*/
		case SQL_DOUBLE:		return MODBC_FLOAT;
		case SQL_FLOAT:			return MODBC_FLOAT;
		case SQL_INTEGER:		return MODBC_INT;

	/* 
	** For MySQL, SQLGetData does not work correctly (multiple calls 
	** return the same data, not successive pieces of the data).
	** It seems to be guaranteed to be able to find the maximum length
	** of the data in the column, so we treat those columns as if
	** they were fixed length. 
	*/
#ifdef MODBC_MYSQL
		case SQL_LONGVARBINARY:		return MODBC_STRING;
		case SQL_LONGVARCHAR:		return MODBC_STRING;
#else /* ! MODBC_MYSQL */
		case SQL_LONGVARBINARY:		return MODBC_VAR_STRING;
		case SQL_LONGVARCHAR:		return MODBC_VAR_STRING;
#endif /* ! MODBC_MYSQL */

		case SQL_NUMERIC:		return MODBC_STRING;
		case SQL_REAL:			return MODBC_FLOAT;
		case SQL_SMALLINT:		return MODBC_INT;
		case SQL_TIME:			return MODBC_TIME;
		case SQL_TIMESTAMP:		return MODBC_TIME;
		case SQL_TINYINT:		return MODBC_INT;
		case SQL_VARBINARY:		return MODBC_STRING;
		case SQL_VARCHAR:		return MODBC_STRING;
		default:
		    fatal_error(
		    	""odbc.m: sql_type_to_attribute_type: unknown type"");
	}
}

/*
** Return the SQL_C type corresponding to a supported attribute type.
*/
static SWORD 
attribute_type_to_sql_c_type(MODBC_AttrType AttrType)
{
	switch (AttrType) {
		case MODBC_FLOAT:		return SQL_C_DOUBLE;
		case MODBC_INT:			return SQL_C_SLONG;
		case MODBC_TIME:		return SQL_C_CHAR;
		case MODBC_STRING:		return SQL_C_CHAR;
		case MODBC_VAR_STRING:		return SQL_C_CHAR;
		default:
			/* Unsuported MODBC_xxx type */
		    fatal_error(
		    	""odbc.m: attribute_type_to_sql_c_type: unknown type"");
	}
}


/*
** Does the data have no maximum length? 
** Note: the implementation of SQLGetData for MySQL does not follow the same 
** standard as SQL Server, but from examination of the sources SQLDescribeCol
** seems guaranteed to find the maximum length of a result column containing 
** variable length data. SQL_NO_TOTAL, which should be returned if the length
** cannot be determined, is not defined by the iODBC header files. 
*/
static bool 
is_variable_length_sql_type(SWORD sql_type) {

#ifdef MODBC_MYSQL

	return FALSE;

#else /* ! MODBC_MYSQL */

	return (
		sql_type == SQL_LONGVARBINARY ||	
		sql_type == SQL_LONGVARCHAR
	);

#endif /* !MODBC_MYSQL */
}

/*
** This function computes to total number of bytes needed
** to store an attribute value, returning -1 if there is no
** maximum size. 
** [SqlType] is the ODBC SQL type of the column
** [cbColDef] is the size returned by SQLDescribeCol
** [ibScaler] is the scale returned by SQLDescribeCol
** [fNullable] is whether the column can be NULL
*/
static size_t 
sql_type_to_size(SWORD sql_type, UDWORD cbColDef, 
		SWORD ibScale, SWORD fNullable)
{
	switch (sql_type)
	{
		/*
		** 64-bit signed int converted to SQL_C_CHAR 
		*/
		case SQL_BIGINT:
			return 1 + cbColDef + 1;  /* +1 for sign, +1 for NUL */

		/*
		** Binary data converted to SQL_C_CHAR 
		** Each byte is converted to 2-digit Hex 
		*/
		case SQL_BINARY:
			return cbColDef * 2 + 1;  /* +1 for NUL */

		/*
		** Bit converted to SQL_C_CHAR 
		*/
		case SQL_BIT:
			return cbColDef + 1;  /* +1 for NUL */

		/*
		** Fixed char to SQL_C_CHAR  
		*/
		case SQL_CHAR:
			return cbColDef + 1;  /* 1 for NUL */

		/*
		** Date YYYY-MM-DD converted to SQL_C_CHAR
		*/
		case SQL_DATE:
			return cbColDef + 1;  /* 1 for NUL */

		/*
		** Signed decimal ddd.dd converted to SQL_C_CHAR
		*/
		case SQL_DECIMAL:
			return 1 + cbColDef + 1 + ibScale + 1; 
			/* 1 for sign 1, 1 for decimal point, 1, for NUL */

		/*
		** 32-bit float converted to MODBC_SQL_C_FLOAT
		*/
		case SQL_DOUBLE:
			return sizeof(MODBC_C_FLOAT);

		/*
		** 32-bit float converted to MODBC_SQL_C_FLOAT
		*/
		case SQL_FLOAT:
			return sizeof(MODBC_C_FLOAT);

		/*
		** 32-bit integer converted to SQL_C_SLONG
		*/
		case SQL_INTEGER:
			return sizeof(MODBC_C_INT);

		/*
		** Any length binary convert to SQL_C_CHAR
		** For MySQL, there are no column types for 
		** which the maximum length cannot be determined before 
		** starting to fetch data, hence the #ifdefs below.
		*/
		case SQL_LONGVARBINARY:
#ifdef MODBC_MYSQL
			return cbColDef * 2 + 1;	/* 1 for NUL */
#else /* !MODBC_MYSQL */
			return -1;
#endif /* !MODBC_MYSQL */

		/*
		** Any length char convert to SQL_C_CHAR
		** For MySQL, there are no column types for 
		** which the maximum length cannot be determined before 
		** starting to fetch data, hence the #ifdefs below.
		*/
		case SQL_LONGVARCHAR:
#ifdef MODBC_MYSQL
			return cbColDef + 1;	/* 1 for NUL */
#else /* !MODBC_MYSQL */
			return -1;
#endif /* !MODBC_MYSQL */

		/*
		** Signed numeric ddd.dd converted to SQL_C_CHAR
		*/
		case SQL_NUMERIC:
			return 1 + cbColDef + 1 + ibScale + 1;
					/* 1 for NUL */

		/*
		** 32-bit float converted to MODBC_SQL_C_FLOAT
		*/
		case SQL_REAL:
			return sizeof(MODBC_C_FLOAT);

		/*
		** 16-bit integer converted to SQL_C_SLONG
		*/
		case SQL_SMALLINT:
			return sizeof(MODBC_C_INT);

		/*
		** Time hh:mm:ss converted to SQL_C_CHAR
		*/
		case SQL_TIME:
			return cbColDef + 1;  /* 1 for NUL */

		/*
		** Time YYYY-MM-DD hh:mm:ss converted to SQL_C_CHAR
		*/
		case SQL_TIMESTAMP:
			return cbColDef + 1;  /* 1 for NUL */

		/*
		** 8-bit integer converted to MODBC_SQL_INT
		*/
		case SQL_TINYINT:
			return sizeof(MODBC_C_INT);

		/*
		** Binary data converted to SQL_C_CHAR 
		** Each byte is converted to 2-digit Hex 
		*/
		case SQL_VARBINARY:
			return cbColDef * 2 + 1;  /* 1 for NUL */

		/*
		** Fixed char to SQL_C_CHAR  
		*/
		case SQL_VARCHAR:
			return cbColDef + 1;  /* 1 for NUL */

		default:
		    fatal_error(""odbc.m: sql_type_to_size: unknown type"");
	}
}
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

	%
	% Catalog functions.
	%

odbc__data_sources(MaybeSources - Messages) -->
	odbc__sql_data_sources(RevSourceNames, RevDescs, Status, RevMessages),
	( { odbc__ok(Status) } ->
		{ list__reverse(RevMessages, Messages) },
		{ list__reverse(RevSourceNames, SourceNames) },
		{ list__reverse(RevDescs, Descs) },
		{ assoc_list__from_corresponding_lists(SourceNames, 
			Descs, SourceAL) },
		{ MakeSource = lambda([Pair::in, SourceDesc::out] is det, (
				Pair = SourceName - Desc,
				SourceDesc = odbc__source_desc(SourceName, Desc)
			)) },
		{ list__map(MakeSource, SourceAL, Sources) },
		{ MaybeSources = ok(Sources) }
	; { odbc__no_data(Status) } ->
		% iODBC 2.12 doesn't implement this function.
		{ Messages = [
			error(feature_not_implemented) - 
			"[Mercury][odbc.m]SQLDataSources not implemented."
		] },
		{ MaybeSources = error }
	;	
		{ list__reverse(RevMessages, Messages) },
		{ MaybeSources = error }
	).
	
:- pred odbc__sql_data_sources(list(string)::out, list(string)::out, int::out, 
		list(odbc__message)::out, io__state::di, io__state::uo) is det.

:- pragma c_code(
		odbc__sql_data_sources(SourceNames::out, SourceDescs::out,
			Status::out, Messages::out, IO0::di, IO::uo),
		may_call_mercury,
"{
		/*
		** Note that iODBC-2.12 doesn't implement 
		** SQLDataSources, and always returns SQL_SUCCESS, 
		** causing an infinite loop if we call the stub.
		*/
#ifdef MODBC_IODBC
	Status = SQL_NO_DATA_FOUND;
	SourceNames = list_empty();
	SourceDescs = list_empty();
	Messages = list_empty();
#else /* !MODBC_IODBC */
	Status = odbc_do_get_data_sources(&SourceNames, 
			&SourceDescs, &Messages);
#endif /* !MODBC_IODBC */

	IO = IO0;
}").

:- pragma c_header_code("

SQLRETURN odbc_do_get_data_sources(Word *SourceNames, 
		Word *SourceDescs, Word *Messages);
").

:- pragma c_code("

SQLRETURN
odbc_do_get_data_sources(Word *SourceNames, Word *SourceDescs, Word *Messages)
{
	char dsn[SQL_MAX_DSN_LENGTH];
	char desc[128];	/*
			** Arbitrary size, only needs to hold a 
			** descriptive string like ""SQL Server"".
			*/
	String new_dsn;
	String new_desc;
	SWORD dsn_len;
	SWORD desc_len;
	SQLRETURN rc;

	odbc_message_list = list_empty();
	*SourceNames = list_empty();
	*SourceDescs = list_empty();

	if (odbc_env_handle == SQL_NULL_HENV) {
		rc = SQLAllocEnv(&odbc_env_handle);
	} else {
		rc = SQL_SUCCESS;
	}

	DEBUG(printf(""SQLAllocEnv status: %d\\n"", rc));

	if (odbc_check(odbc_env_handle, SQL_NULL_HDBC, 
			SQL_NULL_HSTMT, rc)) {

		rc = SQLDataSources(odbc_env_handle, SQL_FETCH_FIRST,
				dsn, SQL_MAX_DSN_LENGTH - 1,
				&dsn_len, desc, sizeof(desc), &desc_len);

			/*
			** The documentation varies on whether the driver
			** returns SQL_NO_DATA_FOUND or SQL_NO_DATA, so
			** check for both.
			*/
		while (rc != SQL_NO_DATA_FOUND && rc != SQL_NO_DATA && 
				odbc_check(odbc_env_handle, SQL_NULL_HDBC, 
					SQL_NULL_HSTMT, rc)) 
		{

			/* 
			** Copy the new data onto the Mercury heap
			*/
			make_aligned_string_copy(new_dsn, dsn);
			*SourceNames = list_cons(new_dsn, *SourceNames);
			make_aligned_string_copy(new_desc, desc);
			*SourceDescs = list_cons(new_desc, *SourceDescs);
	
			rc = SQLDataSources(odbc_env_handle,
					SQL_FETCH_NEXT, dsn,
					SQL_MAX_DSN_LENGTH - 1, &dsn_len, 
					desc, sizeof(desc), &desc_len);
		}
	}

	if (rc == SQL_NO_DATA_FOUND) {
		rc = SQL_SUCCESS;
	}

	*Messages = odbc_message_list;
	odbc_message_list = list_empty();
	return rc;
}").

%-----------------------------------------------------------------------------%

odbc__tables(Qualifier, Owner, TableName, Tables) -->
	{ odbc__convert_pattern_argument(Qualifier, QualifierStr,
		QualifierStatus) },
	{ odbc__convert_pattern_argument(Owner, OwnerStr, OwnerStatus) },
	{ odbc__convert_pattern_argument(TableName, TableStr, TableStatus) },
	odbc__get_result_set(odbc__sql_tables(QualifierStr, QualifierStatus,
		OwnerStr, OwnerStatus, TableStr, TableStatus), Results),
	list__map_foldl(odbc__convert_table_desc, Results, Tables).

:- pred odbc__convert_table_desc(odbc__row, odbc__table_desc, 
		odbc__state, odbc__state).
:- mode odbc__convert_table_desc(in, out, di, uo) is det.

odbc__convert_table_desc(Row0, Table) -->
	{ NullToEmptyStr = 
		lambda([Data0::in, Data::out] is det, (
			( Data0 = null ->
				Data = string("")
			;
				Data = Data0
			)
		)) },
	{ list__map(NullToEmptyStr, Row0, Row) },
	(
		{ Row = [string(Qualifier), string(Owner), string(Name), 
			string(Type), string(Description) | DriverColumns] } 
	->
		{ Table = odbc__table_desc(Qualifier, Owner, Name, 
			Type, Description, DriverColumns) }
	;
		odbc__add_message(error(internal_error) - 
			"[Mercury][odbc.m]Invalid results from SQLTables."),
		odbc__throw
	).

%-----------------------------------------------------------------------------%

	% odbc__convert_pattern_argument(Pattern, String, Status).
	% This is used in a fairly crude interface to C. If the Status is 0,
	% the corresponding argument to the ODBC function should be NULL,
	% meaning no constraint on the search. If the Status is 1, the
	% argument to the ODBC function should be the given string.

:- pred odbc__convert_pattern_argument(odbc__search_pattern::in, 
		string::out, int::out) is det.

odbc__convert_pattern_argument(any, "", 0).
odbc__convert_pattern_argument(pattern(Str), Str, 1).

:- pred odbc__sql_tables(string, int, string, int, string, int,
		odbc__statement, odbc__statement,
		odbc__state, odbc__state).
:- mode odbc__sql_tables(in, in, in, in, in, in, di, uo, di, uo) is det.

:- pragma c_code(odbc__sql_tables(QualifierStr::in, QualifierStatus::in,
		OwnerStr::in, OwnerStatus::in, TableStr::in, TableStatus::in,
		Statement0::di, Statement::uo, DB0::di, DB::uo), 
		may_call_mercury,
"{
	MODBC_Statement *statement = (MODBC_Statement *) Statement0;
	char *qualifier_str = NULL;
	char *owner_str = NULL;
	char *table_str = NULL;
	int qualifier_len = 0;
	int owner_len = 0;
	int table_len = 0;
	SQLRETURN rc;

	/*
	** A NULL pointer in any of the string pattern fields
	** means no constraint on the search for that field.
	*/
	if (QualifierStatus) {
		qualifier_str = (char *) QualifierStr;
		qualifier_len = strlen(qualifier_str);
	}
	if (OwnerStatus) {
		owner_str = (char *) OwnerStr;
		owner_len = strlen(owner_str);
	}
	if (TableStatus) {
		table_str = (char *) TableStr;
		table_len = strlen(table_str);	
	}

	rc = SQLTables(statement->stat_handle, qualifier_str, 
			qualifier_len, owner_str, owner_len,
			table_str, table_len, NULL, 0);
	if (! odbc_check(odbc_env_handle, odbc_connection, 
			statement->stat_handle, rc)) {
		odbc_do_cleanup_statement(statement);
		odbc_throw();
	}

	DB = DB0;
	Statement = (Word) statement;
}").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

	% 
	% Error checking.
	%

:- pred odbc__ok(int).
:- mode odbc__ok(in) is semidet.

:- pragma c_code(odbc__ok(Status::in), will_not_call_mercury,

"
SUCCESS_INDICATOR = (Status == SQL_SUCCESS || Status == SQL_SUCCESS_WITH_INFO);
").

:- pred odbc__no_data(int).
:- mode odbc__no_data(in) is semidet.

:- pragma c_code(odbc__no_data(Status::in), will_not_call_mercury,
"
SUCCESS_INDICATOR = (Status == SQL_NO_DATA_FOUND);
").

%-----------------------------------------------------------------------------%

	% Handle ODBC error codes. Refer to the ODBC API Reference 
	% provided with the ODBC SDK. The first two characters of the 
	% SQLSTATE are meant to specify an error class. Looking at the 
	% predicates below, the classes weren't terribly well chosen.
:- pred odbc__sql_state_to_message(string::in, string::in,
		odbc__message::out) is det.
:- pragma export(odbc__sql_state_to_message(in, in, out), 
		"MODBC_odbc_sql_state_to_message").

odbc__sql_state_to_message(SQLState, String, Message - String) :-
	string__split(SQLState, 2, Class, SubClass),
	( Class = "01" ->
		( sql_state_to_warning(SubClass, Warning) ->
			Message = warning(Warning)
		;
			Message = warning(general_warning)
		)
	;
		( sql_state_to_error(Class, SubClass, Error) ->
			Message = error(Error)
		;
			Message = error(general_error)
		)
	).

:- pred sql_state_to_warning(string::in, odbc__warning::out) is semidet.
sql_state_to_warning("000", general_warning).
sql_state_to_warning("001", general_warning).
sql_state_to_warning("002", disconnect_error).
sql_state_to_warning("003", null_value_in_set_function).
sql_state_to_warning("004", string_data_truncated).
sql_state_to_warning("006", privilege_not_revoked).
sql_state_to_warning("007", privilege_not_granted).
sql_state_to_warning("S03", general_warning).
sql_state_to_warning("S04", general_warning).

:- pred sql_state_to_error(string::in, string::in,
		odbc__error::out) is semidet.

sql_state_to_error("07", "002", execution_error(incorrect_count_field)).
sql_state_to_error("07", "005", general_error).
sql_state_to_error("07", "006", 
			execution_error(restricted_data_type_violation)).
sql_state_to_error("07", "009", general_error).
sql_state_to_error("07", "S01", internal_error).

sql_state_to_error("08", "001", connection_error(unable_to_establish)).
sql_state_to_error("08", "002", connection_error(connection_name_in_use)).
sql_state_to_error("08", "003", connection_error(nonexistent_connection)).
sql_state_to_error("08", "004", 
			connection_error(connection_rejected_by_server)).
sql_state_to_error("08", "007", connection_error(connection_failure)).
sql_state_to_error("08", "S01", connection_error(connection_failure)).


sql_state_to_error("21", "S01", execution_error(invalid_insert_value_list)).
sql_state_to_error("21", "S02", execution_error(incorrect_derived_table_arity)).

sql_state_to_error("22", "001", execution_error(string_data_truncated)).
sql_state_to_error("22", "002", execution_error(general_error)).
sql_state_to_error("22", "003", execution_error(range_error)).
sql_state_to_error("22", "007", execution_error(invalid_date_time)).
sql_state_to_error("22", "008", execution_error(overflow)).
sql_state_to_error("22", "012", execution_error(division_by_zero)).
sql_state_to_error("22", "015", execution_error(overflow)).
sql_state_to_error("22", "018", execution_error(invalid_cast_specification)).
sql_state_to_error("22", "019", execution_error(invalid_escape)).
sql_state_to_error("22", "025", execution_error(invalid_escape)).
sql_state_to_error("22", "026", execution_error(string_data_length_mismatch)).

sql_state_to_error("23", "000", 
			execution_error(integrity_constraint_violation)).

sql_state_to_error("24", "000", execution_error(general_error)).

sql_state_to_error("25", "S00", transaction_error(invalid_state)).
sql_state_to_error("25", "S01", transaction_error(invalid_state)).
sql_state_to_error("25", "S02", transaction_error(still_active)).
sql_state_to_error("25", "S03", transaction_error(rolled_back)).

sql_state_to_error("28", "000", connection_error(invalid_authorization)).

sql_state_to_error("37", "000", 
			execution_error(syntax_error_or_access_violation)).

sql_state_to_error("3C", "000", execution_error(general_error)).

sql_state_to_error("3D", "000", execution_error(general_error)).

sql_state_to_error("3F", "000", execution_error(invalid_schema_name)).

sql_state_to_error("40", "001", transaction_error(serialization_failure)).
sql_state_to_error("40", "003", execution_error(general_error)).

sql_state_to_error("42", "000", 
			execution_error(syntax_error_or_access_violation)).
sql_state_to_error("42", "S01", execution_error(table_or_view_already_exists)).
sql_state_to_error("42", "S02", execution_error(table_or_view_not_found)).
sql_state_to_error("42", "S11", execution_error(index_already_exists)).
sql_state_to_error("42", "S12", execution_error(index_not_found)).
sql_state_to_error("42", "S21", execution_error(column_already_exists)).
sql_state_to_error("42", "S22", execution_error(column_not_found)).

sql_state_to_error("44", "000", execution_error(general_error)).

sql_state_to_error("IM", _, internal_error).

sql_state_to_error("HY", SubClass, Error) :-
	( SubClass = "000" ->
		Error = general_error
	; SubClass = "109" ->
		Error = feature_not_implemented
	; SubClass = "T00" ->
		Error = timeout_expired
	; SubClass = "T01" ->
		Error = connection_error(timeout_expired)
	;
		Error = internal_error
	).

sql_state_to_error("S0", "001", execution_error(table_or_view_already_exists)).
sql_state_to_error("S0", "002", execution_error(table_or_view_not_found)).
sql_state_to_error("S0", "011", execution_error(index_already_exists)).
sql_state_to_error("S0", "012", execution_error(index_not_found)).
sql_state_to_error("S0", "021", execution_error(column_already_exists)).
sql_state_to_error("S0", "022", execution_error(column_not_found)).
sql_state_to_error("S0", "023", execution_error(no_default_for_column)).

sql_state_to_error("S1", SubClass, Error) :-
	( SubClass = "000" ->
		Error = general_error
	; SubClass = "C00" ->
		Error = feature_not_implemented
	; SubClass = "T01" ->
		Error = connection_error(timeout_expired)
	;
		Error = internal_error
	).

:- pragma c_code("

/*
** Return TRUE if the last ODBC call succeded.
** Return FALSE if the ODBC call failed.
** Add any error messages to odbc_message_list.
*/
static bool
odbc_check(SQLHENV env_handle, SQLHDBC connection_handle, 
		SQLHSTMT statement_handle, SQLRETURN rc)
{
	SQLRETURN	status;
	SQLINTEGER	native_error;
	SQLSMALLINT	msg_len;
	UCHAR		message[SQL_MAX_MESSAGE_LENGTH];
	UCHAR		sql_state[SQL_SQLSTATE_SIZE + 1];
	String 		mercury_message;
	Word		new_message;

	MR_ASSERT_IMPLY(connection_handle == SQL_NULL_HDBC, 
			statement_handle == SQL_NULL_HSTMT);

	odbc_ret_code = rc;

	/* Check type of error */
	if (rc == SQL_SUCCESS) { 
		return TRUE;
	} else {

		DEBUG(printf(""getting error message for status %i\\n"", rc));

		while (1) {

			status = SQLError(env_handle, connection_handle, 
				statement_handle, sql_state, &native_error, 
				message, SQL_MAX_MESSAGE_LENGTH - 1, &msg_len);

			DEBUG(printf(""SQLError status: %i\\n"", status));
			DEBUG(printf(""SQL_STATE: %s\\n"", sql_state));
			DEBUG(printf(""Error: %s\\n"", message));

			if (status != SQL_SUCCESS) {
				break;
			}


			/* Copy the error string to the Mercury heap. */
			make_aligned_string_copy(mercury_message, message);

			/* Convert the SQL state to an odbc__message. */
			MODBC_odbc_sql_state_to_message(sql_state,
				mercury_message, &new_message);

			/* Append the message onto the list. */
			odbc_message_list = 
				list_cons(new_message, odbc_message_list);

		}

		if (rc == SQL_SUCCESS_WITH_INFO) {
			return TRUE;
		} else {
			return FALSE;
		}
	}
}

").

:- end_module odbc.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%


%-----------------------------------------------------------------------------%
% Sample program for odbc.m.
% Author: stayl
% This source file is hereby placed in the public domain.  -stayl.
%
% Assumes that there is an ODBC data source "test" containing a table
% named "test".
%-----------------------------------------------------------------------------%
:- module odbc_test.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

%-----------------------------------------------------------------------------%
:- implementation.

:- import_module list, string, std_util.
:- import_module odbc.

main -->
	odbc__data_sources(SourceResult - SourceMessages),
	( 
		{ SourceResult = ok(Sources) },
		io__write_string("Available data source names:"),
		io__nl,
		io__write_list(Sources, "\n", io__write),
		io__nl
	;
		{ SourceResult = error },
		io__write_string("Error getting DSNs:"),
		io__nl
	),
	io__write_list(SourceMessages, "\n", io__write),
	io__nl,
	odbc__transaction("test", "", "", odbc__tables(any, any, any), 
			TableResult - TableMessages),
	(
		{ TableResult = ok(Tables) },
		io__write_string("Available tables:"),
		io__nl,
		io__write_list(Tables, "\n", io__write),
		io__nl
	;
		{ TableResult = error },
		io__write_string("Error getting tables:"),
		io__nl
	),
	io__write_list(TableMessages, "\n", io__write),
	io__nl,
	odbc__transaction("test", "", "", test_trans, 
		TransResult - TransMessages),
	( 
		{ TransResult = ok(Results) },
		io__write_string("transaction ok: "),
		{ list__length(Results, NumRows) },
		io__write_int(NumRows),
		io__write_string(" result rows"),
		io__nl,
		io__write_list(Results, "\n", io__write),
		io__nl
	;
		{ TransResult = error },
		io__write_string("error in transaction:\n")
	),
	io__write_list(TransMessages, "\n", io__write),
	io__nl.

:- pred test_trans(list(odbc__row)::out,
		odbc__state::di, odbc__state::uo) is det.

test_trans(Results) -->
	{ String = "select * from test" },
	odbc__execute(String, Results).

:- pred output_results(list(odbc__row)::in,
		io__state::di, io__state::uo) is det.

output_results(Rows) -->
	{ WriteRow = lambda([Row::in, IO0::di, IO::uo] is det, (
			io__write_list(Row, " ", output_attribute, IO0, IO)
		)) },
	io__write_list(Rows, "\n", WriteRow).

:- pred output_attribute(odbc__attribute::in, 
		io__state::di, io__state::uo) is det.

output_attribute(null) -->
	io__write_string("<NULL>").
output_attribute(int(Int)) -->
	io__write_int(Int).
output_attribute(string(Str)) -->
	io__write_string(Str).
output_attribute(float(Float)) -->
	io__write_float(Float).
output_attribute(time(String)) -->
	io__write_string(String).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%



More information about the developers mailing list