ODBC interface
Simon TAYLOR
stayl at students.cs.mu.oz.au
Tue Jul 22 19:39:19 AEST 1997
Hi,
This is the result of my hacking at Mission Critical's ODBC interface.
There are a couple of issues with this:
Microsoft's ODBC header files had to be altered slightly to compile
with gcc:
- removed some C++ style comments
- defined the calling convention for the ODBC functions
using attribute((stdcall))
- removed some conflicting typedefs
Is it OK to distribute a patch for these header files, given that they
aren't in the section of the ODBC SDK which is redistributable?
Also I should probably get permission from the Mission Critical people
before this goes in the release, but that shouldn't be a problem. What
should go in the copyright message at the top of odbc.m?
There are two parts to this diff.
=======
Part 1:
=======
Estimated hours taken: 3
runtime/engine.h
runtime/engine.mod
Added macros MR_setjmp and MR_longjmp which in save and restore
the jmp_buf used to return from call_engine_inner. This is needed
to make longjmp work across C->Mercury calls.
runtime/mercury_string.h
Added a macro make_aligned_string_copy, which is the same as
make_aligned_string except that it is guaranteed to do the copy.
This is useful for copying C strings out of buffers onto the
Mercury heap.
runtime/misc.c
Avoid a segfault in debug grades when printing information about
the bottom nondetstack frame.
Index: engine.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/engine.h,v
retrieving revision 1.12
diff -u -r1.12 engine.h
--- engine.h 1997/02/12 02:15:23 1.12
+++ engine.h 1997/07/22 06:39:15
@@ -13,6 +13,8 @@
#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()' */
@@ -42,6 +44,58 @@
#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
+ */
+ } MR_jmp_buf;
+
+ /*
+ ** MR_setjmp(MR_jmp_buf *env)
+ **
+ ** Save MR_engine_jmp_buf, then call setjmp(env).
+ ** setjmp can only occur as an expression, not a statement.
+ ** I'm not certain that this is 100% portable. K&R p254 states
+ ** that "a call to setjmp can only occur in certain contexts,
+ ** basically the test of if, switch and loops, and only in
+ ** simple relational expressions". Is the expression below
+ ** a simple relational expression?
+ */
+#define MR_setjmp(setjmp_env) \
+ ( \
+ (setjmp_env)->mercury_env = MR_engine_jmp_buf, \
+ setjmp((setjmp_env)->env) \
+ )
+
+ /*
+ ** MR_longjmp(MR_jmp_buf *env, int return)
+ **
+ ** Reset MR_engine_jmp_buf to the value stored in env,
+ ** then call longjmp().
+ */
+#define MR_longjmp(setjmp_env, ret) \
+ do { \
+ MR_engine_jmp_buf = (setjmp_env)->mercury_env; \
+ longjmp((setjmp_env)->env, ret); \
+ } while (0)
+
+ /*
+ ** 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: engine.mod
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/engine.mod,v
retrieving revision 1.41
diff -u -r1.41 engine.mod
--- engine.mod 1997/05/26 12:20:02 1.41
+++ engine.mod 1997/06/26 04:01:05
@@ -31,7 +31,7 @@
bool debugflag[MAXFLAG];
-static jmp_buf *engine_jmp_buf;
+jmp_buf *MR_engine_jmp_buf;
/*
** init_engine() calls init_memory() which sets up all the necessary
@@ -128,25 +128,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;
}
@@ -273,7 +273,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 */
@@ -302,7 +302,7 @@
{
save_registers();
debugmsg0("longjmping out...\n");
- longjmp(*engine_jmp_buf, 1);
+ longjmp(*MR_engine_jmp_buf, 1);
}
static Code *
Index: mercury_string.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_string.h,v
retrieving revision 1.4
diff -u -r1.4 mercury_string.h
--- mercury_string.h 1997/02/19 05:36:24 1.4
+++ mercury_string.h 1997/07/17 03:13:36
@@ -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: misc.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/misc.c,v
retrieving revision 1.9
diff -u -r1.9 misc.c
--- misc.c 1997/02/12 07:41:12 1.9
+++ misc.c 1997/06/26 02:09:35
@@ -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 > 0) {
+ 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;
}
=======
Part 2:
=======
extras/odbc/odbc.m
The ODBC interface.
extras/odbc/Mmakefile
Configuration for the odbc interface.
extras/odbc/odbc_test.m
A simple test program.
=====================
extras/odbc/Mmakefile
=====================
#-----------------------------------------------------------------------------#
# 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_SQL_SERVER
MODBC_DB = MODBC_MYSQL
# 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)
MLLIBS=-L$(ODBC_LIB_DIR) -liodbc -ldl
endif
MAIN_TARGET=odbc_test
RM_C=:
#-----------------------------------------------------------------------------#
# gcc aborts with optimization enabled.
MGNUCFLAGS = -D$(MODBC_DRIVER) -D$(MODBC_DB) -O0 -I$(ODBC_INCL_DIR) -I../boehm_gc
#-----------------------------------------------------------------------------#
#-----------------------------------------------------------------------------#
==================
extras/odbc/odbc.m
==================
%---------------------------------------------------------------------------%
% XXX what should go here?
% Copyright (C) 1997 Mission Critical
% Copyright (C) 1997 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.
%
% 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.
%
% To do:
% improve the interface to the catalog functions
%
%-----------------------------------------------------------------------------%
%
:- 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 CatalogPattern.
% 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.
%-----------------------------------------------------------------------------%
:- type odbc__state == unit.
:- pragma c_header_code("
#include ""imp.h""
#include <stdio.h>
#include <stdlib.h>
#include <setjmp.h> /* warning, dodgy code ahead */
#include <assert.h>
#include <sys/time.h>
#include <sys/times.h>
#define ODBC_VER 0x0250
#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
#include <windows.h>
#include ""sql.h""
#include ""sqlext.h""
#include ""sqltypes.h""
#endif /* MODBC_MS */
#include ""odbc.h""
#undef DEBUG
/*
** Assert the implication: a => b
*/
#define MR_ASSERT_IMPLY(a,b) MR_assert( !(a) || (b) )
/*
** Make sure floats get converted to the correct size by the driver.
** Doing the conversion in the driver means we might get warnings
** if precision is lost.
*/
#ifdef USE_SINGLE_PREC_FLOAT
#define MODBC_SQL_FLOAT SQL_FLOAT
#define MODBC_SQL_C_FLOAT SQL_C_FLOAT
#else /* ! USE_SINGLE_PREC_FLOAT */
#define MODBC_SQL_FLOAT SQL_DOUBLE
#define MODBC_SQL_C_FLOAT SQL_C_DOUBLE
#endif /* ! USE_SINGLE_PREC_FLOAT */
/*
** All integers get converted to long by the driver, then to Integer.
** XXX we should return some sort of message if a truncation
** occurs, or use 64 bit integers. For now, storing integers longer
** than a machine word in a database is a bad idea.
*/
typedef long MODBC_SQL_INT;
/*
** 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.
*/
#define odbc_catch() MR_setjmp(&odbc_trans_jmp_buf)
#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 = list_empty();
/* Mercury stuff to be restored on rollback */
static Word *odbc_saved_sp;
static Word *odbc_saved_hp;
static Word *odbc_saved_succip;
static Word *odbc_saved_curfr;
static Word *odbc_saved_maxfr;
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,
"
/*
** All this save_transient_registers()/restore_transient_registers()
** nonsense here and elsewhere is necessary to stop the heap pointer
** being clobbered by the function call in non-GC or accurate GC
** grades.
*/
save_transient_registers();
odbc_transaction_c_code(TypeInfo_for_T, Connection, Closure,
&Results, &Status, &Msgs, IO0, &IO);
restore_transient_registers();
").
%-----------------------------------------------------------------------------%
%
% We definitely don't recommend this method of simulating
% exceptions for general programming.
%
:- 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_saved_hp = hp;
odbc_saved_succip = succip;
odbc_saved_maxfr = maxfr;
odbc_saved_curfr = curfr;
odbc_saved_sp = sp;
odbc_connection = (SQLHDBC) Connection;
/* Set up a location to jump to on a database exception. */
if (odbc_catch()) {
/* if we get here, an exception has occurred */
goto transaction_error;
}
/*
** Anything changed between the call to odbc_catch() and the call to
** ML_odbc__do_transaction() must be declared volatile.
*/
ML_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);
save_transient_registers();
if (! odbc_check(odbc_env_handle, odbc_connection,
SQL_NULL_HSTMT, rc)) {
goto transaction_error;
}
restore_transient_registers();
*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);
/* Get back the saved Mercury state. */
restore_transient_registers();
sp = odbc_saved_sp;
succip = odbc_saved_succip;
hp = odbc_saved_hp;
curfr = odbc_saved_curfr;
maxfr = odbc_saved_maxfr;
/* 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();
return;
}
").
%-----------------------------------------------------------------------------%
% 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),
"ML_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,
"
{
save_transient_registers();
odbc_ret_code = SQL_ERROR;
odbc_throw();
DB = DB0;
}
").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% 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;
save_transient_registers();
if (odbc_env_handle == SQL_NULL_HENV) {
Status = SQLAllocEnv(&odbc_env_handle);
}
else {
Status = SQL_SUCCESS;
}
#ifdef DEBUG
printf(""SQLAllocEnv status: %ld\\n"", Status);
#endif /* DEBUG */
if (odbc_check(odbc_env_handle, SQL_NULL_HDBC,
SQL_NULL_HSTMT, Status)) {
#ifdef DEBUG
printf(""connecting\n"");
#endif /* DEBUG */
Status = SQLAllocConnect(odbc_env_handle, &connect_handle);
#ifdef DEBUG
printf(""SQLAllocConnect status: %ld\\n"", Status);
#endif /* DEBUG */
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);
#ifdef DEBUG
printf(""manual commit status: %ld\\n"", Status);
#endif /* DEBUG */
odbc_check(odbc_env_handle, connect_handle,
SQL_NULL_HSTMT, Status);
}
}
IO = IO0;
Status = SQLConnect(connect_handle,
(UCHAR *)Source, strlen(Source),
(UCHAR *)User, strlen(User),
(UCHAR *)Password, strlen(Password));
#ifdef DEBUG
printf(""connect status: %ld\\n"", Status);
#endif /* DEBUG */
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;
restore_transient_registers();
}
").
%-----------------------------------------------------------------------------%
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,
"
save_transient_registers();
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;
restore_transient_registers();
").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
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(in, out, 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, in, out, di, uo) is det.
odbc__get_rows(Rows, Statement0, Statement) -->
odbc__get_number_of_columns(Statement0, NumColumns),
odbc__get_rows_2(NumColumns, Rows, Statement0, 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, in, out, 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, in, out, 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, in, out, 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("
/*
** 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.
*/
#define MODBC_CHUNK_SIZE 4*1024
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; /* 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(out, di, uo) is det.
:- pragma c_code(odbc__alloc_statement(Statement::out, DB0::di, DB::uo),
may_call_mercury,
"
{
MODBC_Statement *statement;
SQLRETURN rc;
save_transient_registers();
/* Doing manual deallocation of the statement object. */
statement = (MODBC_Statement *) newmem(sizeof(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;
restore_transient_registers();
}
").
%-----------------------------------------------------------------------------%
:- pred odbc__execute_statement(string, odbc__statement, odbc__statement,
odbc__state, odbc__state).
:- mode odbc__execute_statement(in, in, out, di, uo) is det.
:- pragma c_code(
odbc__execute_statement(SQLString::in, Statement0::in,
Statement::out, DB0::di, DB::uo),
may_call_mercury,
"
{
MODBC_Statement *statement = (MODBC_Statement *) Statement0;
SQLRETURN rc;
SQLHSTMT stat_handle = statement->stat_handle;
save_transient_registers();
#ifdef DEBUG
printf(""executing SQL string: %s\\n"", SQLString);
#endif /* DEBUG */
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 */
}
#ifdef DEBUG
printf(""execution succeeded\\n"");
#endif /* DEBUG */
Statement = (Word) statement;
DB = DB0;
restore_transient_registers();
}").
%-----------------------------------------------------------------------------%
%
% 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(in, out, di, uo) is det.
:- pragma c_code(odbc__bind_columns(Statement0::in, Statement::out,
DB0::di, DB::uo), may_call_mercury,
"{
int column_no;
MODBC_Statement *statement;
SQLSMALLINT num_columns;
MODBC_Column *column;
SQLRETURN rc;
SQLHSTMT stat_handle;
save_transient_registers();
statement = (MODBC_Statement *) Statement0;
stat_handle = statement->stat_handle;
/*
** Retreive 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 of pointers to the info for each column
*/
statement->row = newmem((num_columns + 1)*
sizeof(MODBC_Column *));
/*
** 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 = newmem(sizeof(MODBC_Column));
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);
#ifdef DEBUG
printf(""column %i: type%i length %i scale %i nullable %i\n"",
column_no, col_type, pcbColDef,
pibScale, pfNullable);
#endif /* DEBUG */
/*
** 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);
#ifdef 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);
#endif /* DEBUG */
statement->row[column_no] = column;
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++) {
#ifdef DEBUG
printf(""Binding column %d/%d\\n"",
column_no, statement->num_columns);
#endif /* DEBUG */
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;
restore_transient_registers();
} /* 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(in, out, out, di, uo) is det.
:- pragma c_code(odbc__fetch(Statement0::in, Statement::out,
Status::out, DB0::di, DB::uo),
may_call_mercury,
"{
MODBC_Statement *stat;
save_transient_registers();
stat = (MODBC_Statement *) Statement0;
MR_assert(stat != NULL);
#ifdef DEBUG
if (stat->num_rows == 0 ) {
printf(""Fetching rows...\\n"");
}
#endif /* DEBUG */
/* 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 */
}
#ifdef DEBUG
/* Update number of rows fetched */
if (Status == SQL_SUCCESS) {
stat->num_rows++;
}
if (Status == SQL_NO_DATA_FOUND) {
printf(""Fetched %d rows\\n"", stat->num_rows);
}
#endif /* DEBUG */
Statement = (Word) stat;
DB = DB0;
restore_transient_registers();
}").
%-----------------------------------------------------------------------------%
:- pred odbc__get_number_of_columns(odbc__statement, int,
odbc__state, odbc__state).
:- mode odbc__get_number_of_columns(in, out, di, uo) is det.
:- pragma c_code(odbc__get_number_of_columns(Statement::in, NumColumns::out,
DB0::di, DB::uo),
will_not_call_mercury,
"{
MODBC_Statement * stat;
stat = (MODBC_Statement *) Statement;
MR_assert(stat != NULL);
NumColumns = stat->num_columns;
DB = DB0;
}").
%-----------------------------------------------------------------------------%
:- 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, in, out, di, uo) is det.
:- pragma c_code(odbc__get_data(Column::in, Int::out, Flt::out, Str::out,
Type::out, Statement0::in, Statement::out, 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);
MR_assert(stat->row[Column] != NULL);
if (stat->binding_type == MODBC_GET_DATA) {
/* Slurp up the data for this column. */
save_transient_registers();
odbc_do_get_data(stat, Column);
restore_transient_registers();
}
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:
Int = (Integer) *(MODBC_SQL_INT *)(col->data);
#ifdef DEBUG
printf(""got integer %ld\\n"", Int);
#endif /* DEBUG */
break;
case MODBC_FLOAT:
Flt = *(Float *)(col->data);
#ifdef DEBUG
printf(""got float %f\\n"", Flt);
#endif /* DEBUG */
break;
case MODBC_STRING:
case MODBC_TIME:
make_aligned_string_copy(Str, (char *) col->data);
#ifdef DEBUG
printf(""got string %s\\n"", (char *) Str);
#endif /* DEBUG */
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);
#ifdef DEBUG
printf(""got var string %s\\n"", (char *) col->data);
#endif /* DEBUG */
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;
} /* switch (Type) */
Statement = (Word) stat;
DB = DB0;
} /* 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 NULL 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();
}
printf(""value_info: %li\n"", column->value_info);
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;
restore_transient_registers();
column->data = newmem(column->size);
save_transient_registers();
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;
#ifdef DEBUG
printf(""getting column %i in one go\n"", column_id);
#endif /* DEBUG */
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 = list_empty();
String result;
#ifdef DEBUG
printf(""getting column %i in chunks\n"", column_id);
#endif /* DEBUG */
col = stat->row[column_id];
rc = SQL_SUCCESS_WITH_INFO;
restore_transient_registers();
incr_hp_atomic(this_bit, MODBC_CHUNK_SIZE / sizeof(Word));
save_transient_registers();
/*
** 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();
}
#ifdef DEBUG
printf(""Got chunk %s\n"", (char *) this_bit);
#endif
restore_transient_registers();
chunk_list = list_cons(this_bit, chunk_list);
incr_hp_atomic(this_bit, MODBC_CHUNK_SIZE / sizeof(Word));
save_transient_registers();
}
ML_odbc_condense_chunks(chunk_list, &result);
col->data = (Word *) result;
}
").
:- pred odbc__condense_chunks(list(string), string).
:- mode odbc__condense_chunks(in, out) is det.
:- pragma export(odbc__condense_chunks(in, out), "ML_odbc_condense_chunks").
odbc__condense_chunks(RevChunks, String) :-
list__reverse(RevChunks, Chunks),
string__append_list(Chunks, String).
%-----------------------------------------------------------------------------%
% The first argument should really be moded di.
:- pred odbc__cleanup_statement_check_error(odbc__statement,
odbc__state, odbc__state).
:- mode odbc__cleanup_statement_check_error(in, di, uo) is det.
:- pragma c_code(
odbc__cleanup_statement_check_error(Statement::in, DB0::di, DB::uo),
may_call_mercury,
"{
MODBC_Statement *stat;
SQLRETURN rc;
save_transient_registers();
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;
restore_transient_registers();
}").
:- pragma c_code("
static SQLRETURN
odbc_do_cleanup_statement(MODBC_Statement *stat)
{
int i;
SQLRETURN rc;
if (stat != NULL) {
#ifdef DEBUG
printf(""cleaning up statement\\n"");
#endif /* DEBUG */
if (stat->row != NULL) {
for (i = 1; i <= stat->num_columns; i++) {
if (stat->row[i] != NULL) {
oldmem(stat->row[i]->data);
oldmem(stat->row[i]);
}
}
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;
#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 MODBC_SQL_C_FLOAT;
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 source 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. So much
** for transparent access to different databases.
*/
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 == '\\0') */
/*
** Binary data converted to SQL_C_CHAR
** Each byte is converted to 2-digit Hex
*/
case SQL_BINARY:
return cbColDef * 2 + 1; /* (+ 1 == '\\0') */
/*
** Bit converted to SQL_C_CHAR
*/
case SQL_BIT:
return cbColDef + 1; /* (+ 1 == '\\0') */
/*
** Fixed char to SQL_C_CHAR
*/
case SQL_CHAR:
return cbColDef + 1; /* (+ 1 == '\\0') */
/*
** Date YYYY-MM-DD converted to SQL_C_CHAR
*/
case SQL_DATE:
return cbColDef + 1; /* (+ 1 == '\\0') */
/*
** Signed decimal ddd.dd converted to SQL_C_CHAR
*/
case SQL_DECIMAL:
return 1 + cbColDef + 1 + ibScale + 1;
/* (+ 1 == '\\0') */
/*
** 32-bit float converted to MODBC_SQL_C_FLOAT
*/
case SQL_DOUBLE:
return sizeof(Float);
/*
** 32-bit float converted to MODBC_SQL_C_FLOAT
*/
case SQL_FLOAT:
return sizeof(Float);
/*
** 32-bit integer converted to SQL_C_SLONG
*/
case SQL_INTEGER:
return sizeof(MODBC_SQL_INT);
/*
** Any length binary convert to SQL_C_CHAR
*/
case SQL_LONGVARBINARY:
#ifdef MODBC_MYSQL
return cbColDef + 1;
#else /* !MODBC_MYSQL */
return -1;
#endif /* !MODBC_MYSQL */
/*
** Any length char convert to SQL_C_CHAR
*/
case SQL_LONGVARCHAR:
#ifdef MODBC_MYSQL
return cbColDef + 1;
#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 == '\\0') */
/*
** 32-bit float converted to MODBC_SQL_C_FLOAT
*/
case SQL_REAL:
return sizeof(Float);
/*
** 16-bit integer converted to SQL_C_SLONG
*/
case SQL_SMALLINT:
return sizeof(MODBC_SQL_INT);
/*
** Time hh:mm:ss converted to SQL_C_CHAR
*/
case SQL_TIME:
return cbColDef + 1; /* (+ 1 == '\\0') */
/*
** Time YYYY-MM-DD hh:mm:ss converted to SQL_C_CHAR
*/
case SQL_TIMESTAMP:
return cbColDef + 1; /* (+ 1 == '\\0') */
/*
** 8-bit integer converted to MODBC_SQL_INT
*/
case SQL_TINYINT:
return sizeof(MODBC_SQL_INT);
/*
** Binary data converted to SQL_C_CHAR
** Each byte is converted to 2-digit Hex
*/
case SQL_VARBINARY:
return cbColDef * 2 + 1; /* (+ 1 == '\\0') */
/*
** Fixed char to SQL_C_CHAR
*/
case SQL_VARCHAR:
return cbColDef + 1; /* (+ 1 == '\\0') */
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 by iODBC 2.12"
] },
{ 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 */
save_transient_registers();
Status = odbc_do_get_data_sources(&SourceNames,
&SourceDescs, &Messages);
restore_transient_registers();
#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;
}
#ifdef DEBUG
printf(""SQLAllocEnv status: %d\\n"", rc);
#endif /* DEBUG */
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
*/
restore_transient_registers();
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);
save_transient_registers();
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, in, out, di, uo) is det.
:- pragma c_code(odbc__sql_tables(QualifierStr::in, QualifierStatus::in,
OwnerStr::in, OwnerStatus::in, TableStr::in, TableStatus::in,
Statement0::in, Statement::out, 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;
save_transient_registers();
/*
** 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;
restore_transient_registers();
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),
"ML_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.
** This allocates heap space and calls Mercury, so be sure to call
** save_transient_registers/restore_transient_registers around this.
*/
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);
MR_ASSERT_IMPLY(statement_handle != SQL_NULL_HSTMT,
connection_handle != SQL_NULL_HDBC);
odbc_ret_code = rc;
/* Check type of error */
if (rc == SQL_SUCCESS) {
return TRUE;
}
else {
#ifdef DEBUG
printf(""getting error message for status %i\\n"", rc);
#endif /* DEBUG */
while (1) {
status = SQLError(env_handle, connection_handle,
statement_handle, sql_state, &native_error,
message, SQL_MAX_MESSAGE_LENGTH - 1, &msg_len);
#ifdef DEBUG
printf(""SQLError status: %i\\n"", status);
printf(""SQL_STATE: %s\\n"", sql_state);
printf(""Error: %s\\n"", message);
#endif /* DEBUG */
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. */
ML_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.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
=======================
extras/odbc/odbc_test.m
=======================
%-----------------------------------------------------------------------------%
% Sample program for odbc.m.
%
% 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),
(
{ SourceResult = ok(Sources) - SourceMessages },
io__write_string("Available data source names:"),
io__nl,
io__write_list(Sources, "\n", io__write),
io__nl
;
{ SourceResult = error - SourceMessages },
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([]) --> [].
output_results([Row | Rows]) -->
output_row(Row),
io__write_string("\n"),
output_results(Rows).
:- pred output_row(list(odbc__attribute)::in,
io__state::di, io__state::uo) is det.
output_row([]) --> [].
output_row([Attr | Attrs]) -->
output_attribute(Attr),
io__write_string(" "),
output_row(Attrs).
:- 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