+ outlined the support for SQLBindParameter()

This commit is contained in:
eknauel 2003-04-28 12:33:02 +00:00
parent 35f1ddd533
commit fd4634e27f
4 changed files with 251 additions and 8 deletions

View File

@ -1,8 +1,9 @@
(define-structure low-odbc low-odbc-interface (define-structure low-odbc low-odbc-interface
(open (open
scheme external-calls scsh-utilities scheme external-calls scsh-utilities
define-record-types srfi-1 define-record-types
conditions signals) conditions signals
low-odbc-constants)
(files odbc)) (files odbc))
(define-structure low-odbc-constants low-odbc-constants-interface (define-structure low-odbc-constants low-odbc-constants-interface

View File

@ -412,7 +412,7 @@ s48_value odbc_sql_set_connect_attr_int(s48_value conn_handle,
ch = (SQLHDBC) s48_extract_integer(conn_handle); ch = (SQLHDBC) s48_extract_integer(conn_handle);
attr = (SQLINTEGER) s48_extract_integer(attribute); attr = (SQLINTEGER) s48_extract_integer(attribute);
val = (SQLUINTEGER) s48_extract_integer(value); val = (SQLUINTEGER) s48_extract_integer(value);
retval = SQLSetConnectAttr(ch, attr, &val, 0); retval = SQLSetConnectAttr(ch, attr, (SQLPOINTER) &val, 0);
return s48_enter_integer(retval); return s48_enter_integer(retval);
#else #else
@ -774,7 +774,71 @@ s48_value odbc_sql_prepare(s48_value stmt_handle, s48_value stmt_txt)
return s48_enter_integer(retval); return s48_enter_integer(retval);
} }
/* FIXME: implement SQLBindParameter */ s48_value odbc_sql_bind_parameter(s48_value bind_parameter_rec)
{
SQLHSTMT sh;
SQLUSMALLINT param_no;
SQLSMALLINT in_out_type, value_type, param_type, decimal_digits;
SQLUINTEGER column_size;
SQLPOINTER parameter_value_input_ptr, parameter_value_output_ptr;
SQLINTEGER buffer_length;
SQLRETURN retval;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(bind_parameter_rec);
sh = (SQLHSTMT)
s48_extract_integer(S48_RECORD_REF(bind_parameter_rec,
SR_ODBC_BIND_PARAMETER_STATEMENT_HANDLE));
param_no = (SQLUSMALLINT)
s48_extract_integer(S48_RECORD_REF(bind_parameter_rec,
SR_ODBC_BIND_PARAMETER_PARAM_NO));
in_out_type = (SQLSMALLINT)
s48_extract_integer(S48_RECORD_REF(bind_parameter_rec,
SR_ODBC_BIND_PARAMETER_INPUT_OUTPUT_TYPE));
value_type = (SQLSMALLINT)
s48_extract_integer(S48_RECORD_REF(bind_parameter_rec,
SR_ODBC_BIND_PARAMETER_VALUE_TYPE));
param_type = (SQLSMALLINT)
s48_extract_integer(S48_RECORD_REF(bind_parameter_rec,
SR_ODBC_BIND_PARAMETER_PARAMETER_TYPE));
column_size = (SQLUINTEGER)
s48_extract_integer(S48_RECORD_REF(bind_parameter_rec,
SR_ODBC_BIND_PARAMETER_COLUMN_SIZE));
decimal_digits = (SQLSMALLINT)
s48_extract_integer(S48_RECORD_REF(bind_parameter_rec,
SR_ODBC_BIND_PARAMETER_DECIMAL_DIGITS));
buffer_length = (SQLINTEGER)
s48_extract_integer(S48_RECORD_REF(bind_parameter_rec,
SR_ODBC_BIND_PARAMETER_BUFFER_LENGTH));
parameter_value_input_ptr = (SQLPOINTER)
s48_extract_integer(S48_RECORD_REF(bind_parameter_rec,
SR_ODBC_BIND_PARAMETER_PARAMETER_VALUE_INPUT_PTR));
if ((in_out_type == SQL_PARAM_INPUT_OUTPUT) || (in_out_type == SQL_PARAM_OUTPUT))
parameter_value_output_ptr = (SQLPOINTER) malloc(buffer_length);
else
parameter_value_output_ptr = NULL;
S48_RECORD_SET(bind_parameter_rec,
SR_ODBC_BIND_PARAMETER_PARAMETER_VALUE_OUTPUT_PTR,
s48_enter_integer((long) parameter_value_output_ptr));
/* retval = SQLBindParameter(sh, param_no, in_out_type, value_type, */
/* param_type, column_size, decimal_digits, */
/* param_type); */
S48_GC_UNPROTECT();
}
s48_value bind_parameter_set_buffer(s48_value bind_parameter_rec, s48_value value)
{
return S48_UNSPECIFIC;
}
s48_value bind_parameter_get_buffer(s48_value bind_parameter_rec)
{
return S48_UNSPECIFIC;
}
s48_value odbc_sql_get_cursor_name(s48_value stmt_handle) s48_value odbc_sql_get_cursor_name(s48_value stmt_handle)
{ {
@ -2182,7 +2246,10 @@ void s48_init_odbc(void)
odbc_column_record_type = s48_get_imported_binding("odbc-column"); odbc_column_record_type = s48_get_imported_binding("odbc-column");
S48_GC_PROTECT_GLOBAL(odbc_parameter_record_type); S48_GC_PROTECT_GLOBAL(odbc_parameter_record_type);
odbc_column_record_type = s48_get_imported_binding("odbc-parameter"); odbc_parameter_record_type = s48_get_imported_binding("odbc-parameter");
S48_GC_PROTECT_GLOBAL(odbc_bind_parameter_record_type);
odbc_bind_parameter_record_type = s48_get_imported_binding("odbc-bind-parameter");
S48_GC_PROTECT_GLOBAL(bindcol_buffer_record_type); S48_GC_PROTECT_GLOBAL(bindcol_buffer_record_type);
bindcol_buffer_record_type = s48_get_imported_binding("bindcol-buffer"); bindcol_buffer_record_type = s48_get_imported_binding("bindcol-buffer");
@ -2248,6 +2315,9 @@ void s48_init_odbc(void)
/* PART 5 */ /* PART 5 */
S48_EXPORT_FUNCTION(odbc_sql_prepare); S48_EXPORT_FUNCTION(odbc_sql_prepare);
S48_EXPORT_FUNCTION(odbc_sql_bind_parameter);
S48_EXPORT_FUNCTION(bind_parameter_set_buffer);
S48_EXPORT_FUNCTION(bind_parameter_get_buffer);
S48_EXPORT_FUNCTION(odbc_sql_get_cursor_name); S48_EXPORT_FUNCTION(odbc_sql_get_cursor_name);
S48_EXPORT_FUNCTION(odbc_sql_set_cursor_name); S48_EXPORT_FUNCTION(odbc_sql_set_cursor_name);

View File

@ -129,6 +129,20 @@ static s48_value odbc_parameter_record_type = S48_FALSE;
#define SR_ODBC_PARAMETER_DIGITS 2 #define SR_ODBC_PARAMETER_DIGITS 2
#define SR_ODBC_PARAMETER_NULLABLE 3 #define SR_ODBC_PARAMETER_NULLABLE 3
/* correspons to odbc-bind-parameter */
static s48_value odbc_bind_parameter_record_type = S48_FALSE;
#define SR_ODBC_BIND_PARAMETER_STATEMENT_HANDLE 0
#define SR_ODBC_BIND_PARAMETER_PARAM_NO 1
#define SR_ODBC_BIND_PARAMETER_INPUT_OUTPUT_TYPE 2
#define SR_ODBC_BIND_PARAMETER_VALUE_TYPE 3
#define SR_ODBC_BIND_PARAMETER_PARAMETER_TYPE 4
#define SR_ODBC_BIND_PARAMETER_COLUMN_SIZE 5
#define SR_ODBC_BIND_PARAMETER_DECIMAL_DIGITS 6
#define SR_ODBC_BIND_PARAMETER_PARAMETER_VALUE_INPUT_PTR 7
#define SR_ODBC_BIND_PARAMETER_PARAMETER_VALUE_OUTPUT_PTR 8
#define SR_ODBC_BIND_PARAMETER_BUFFER_LENGTH 9
/* stuff needed for SQLBindCol() */ /* stuff needed for SQLBindCol() */
/* correspons to bindcol-buffer */ /* correspons to bindcol-buffer */
@ -300,6 +314,12 @@ s48_value odbc_sql_get_desc_field_string(s48_value desc_handle, s48_value rec_nu
/* Prepare a SQL statement for execution */ /* Prepare a SQL statement for execution */
s48_value odbc_sql_prepare(s48_value stmt_handle, s48_value stmt_txt); s48_value odbc_sql_prepare(s48_value stmt_handle, s48_value stmt_txt);
s48_value odbc_sql_bind_parameter(s48_value bind_parameter_rec);
s48_value bind_parameter_set_buffer(s48_value bind_parameter_rec, s48_value value);
s48_value bind_parameter_get_buffer(s48_value bind_parameter_rec);
s48_value odbc_sql_get_cursor_name(s48_value stmt_handle); s48_value odbc_sql_get_cursor_name(s48_value stmt_handle);
s48_value odbc_sql_set_cursor_name(s48_value stmt_handle, s48_value cursorname); s48_value odbc_sql_set_cursor_name(s48_value stmt_handle, s48_value cursorname);

View File

@ -16,10 +16,12 @@
(define-exported-binding "connection-handle" :connection-handle) (define-exported-binding "connection-handle" :connection-handle)
(define-record-type statement-handle :statement-handle (define-record-type statement-handle :statement-handle
(really-make-statement-handle handle connection) (really-make-statement-handle handle connection parameter-bindings)
statement-handle? statement-handle?
(handle statement-handle-handle) (handle statement-handle-handle)
(connection statement-handle-connection)) (connection statement-handle-connection)
(parameter-bindings statement-handle-parameter-bindings
set-statement-handle-parameter-bindings!))
(define-exported-binding "statement-handle" :statement-handle) (define-exported-binding "statement-handle" :statement-handle)
@ -150,6 +152,19 @@
(define-exported-binding "raise-odbc-bindcol-rebinding-error" (define-exported-binding "raise-odbc-bindcol-rebinding-error"
raise-odbc-bindcol-rebinding-error) raise-odbc-bindcol-rebinding-error)
;;;
(define-condition-type 'odbc-bind-parameter-rebinding-error '(odbc-error))
(define odbc-bind-parameter-rebinding-error?
(condition-predicate 'odbc-bind-parameter-rebinding-error))
(define (raise-odbc-bind-parameter-rebinding-error
stmt-handle parameter-no this-rebind-order-no current-rebind-order-no)
(apply signal 'odbc-bind-parameter-rebinding-error
'stmt-handle stmt-handle 'parameter-no parameter-no
'this-rebind-order-no this-rebind-order-no
'current-rebind-order-no current-rebind-order-no))
;;; ;;;
(define-record-type odbc-column :odbc-column (define-record-type odbc-column :odbc-column
(really-make-odbc-column name type size digits nullable?) (really-make-odbc-column name type size digits nullable?)
@ -162,6 +177,7 @@
(define-exported-binding "odbc-column" :odbc-column) (define-exported-binding "odbc-column" :odbc-column)
;;; parameter descriptions (returned by SQLDescribeParams())
(define-record-type odbc-parameter :odbc-parameter (define-record-type odbc-parameter :odbc-parameter
(really-make-odbc-parameter type size digits nullable) (really-make-odbc-parameter type size digits nullable)
odbc-parameter? odbc-parameter?
@ -172,6 +188,26 @@
(define-exported-binding "odbc-parameter" :odbc-parameter) (define-exported-binding "odbc-parameter" :odbc-parameter)
;;; parameter bind (for usage with SQLBindParameter())
(define-record-type odbc-bind-parameter :odbc-bind-parameter
(really-make-odbc-bind-parameter
statement-handle parameter-no input-output-type value-type parameter-type
column-size decimal-digits parameter-value-input-ptr parameter-value-output-ptr
buffer-length rebind-order-no)
odbc-bind-parameter?
(statement-handle odbc-bind-parameter-statement-handle)
(parameter-no odbc-bind-parameter-parameter-no)
(input-output-type odbc-bind-parameter-input-output-type)
(value-type odbc-bind-parameter-value-type)
(parameter-type odbc-bind-parameter-parameter-type)
(column-size odbc-bind-parameter-column-size)
(decimal-digits odbc-bind-parameter-decimal-digits)
(parameter-value-input-ptr odbc-bind-parameter-parameter-value-input-ptr)
(parameter-value-output-ptr odbc-bind-parameter-parameter-value-output-ptr)
(buffer-length odbc-bind-parameter-buffer-length)
(rebind-order-no odbc-bind-parameter-rebind-order-no
set-odbc-bind-parameter-rebind-order-no!))
;;; options for SQLFreeStmt from sql.h ;;; options for SQLFreeStmt from sql.h
(define sql-disconnect-opt-close 0) (define sql-disconnect-opt-close 0)
(define sql-disconnect-opt-drop 1) (define sql-disconnect-opt-drop 1)
@ -587,11 +623,12 @@
(status (car status.value)) (status (car status.value))
(value (cadr status.value))) (value (cadr status.value)))
(if (odbc-call-successful? status) (if (odbc-call-successful? status)
(let ((stmt-handle (really-make-statement-handle value conn-handle))) (let ((stmt-handle (really-make-statement-handle value conn-handle '())))
(add-finalizer! stmt-handle free-statement-handle) (add-finalizer! stmt-handle free-statement-handle)
(values status stmt-handle)) (values status stmt-handle))
(values status value)))) (values status value))))
;;; FIXME: free parameter-bindings, dealloc buffers
(define (free-statement-handle stmt-handle) (define (free-statement-handle stmt-handle)
(bindcol-finalize-bindcols (statement-handle-handle stmt-handle)) (bindcol-finalize-bindcols (statement-handle-handle stmt-handle))
(odbc-sql-free-handle stmt-handle)) (odbc-sql-free-handle stmt-handle))
@ -798,6 +835,121 @@
(stmt-handle stmt-txt) (stmt-handle stmt-txt)
"odbc_sql_prepare") "odbc_sql_prepare")
(define (find-bind-parameter stmt-handle parameter-no)
(fold-right
(lambda (bind-parameter res)
(if (= (odbc-bind-parameter-parameter-no bind-parameter) parameter-no)
bind-parameter
res))
#f (statement-handle-parameter-bindings stmt-handle)))
(define (odbc-sql-bind-parameter-set-procedure-maker bind-parameter)
(let ((rebind-order-no (odbc-bind-parameter-rebind-order-no bind-parameter)))
(lambda (value)
(if (= (odbc-bind-parameter-rebind-order-no bind-parameter) rebind-order-no)
(bind-parameter-set-buffer bind-parameter value)
(raise-odbc-bind-parameter-rebinding-error
(odbc-bind-parameter-statement-handle bind-parameter)
(odbc-bind-parameter-parameter-no bind-parameter)
rebind-order-no
(odbc-bind-parameter-rebind-order-no bind-parameter))))))
(define (odbc-sql-bind-parameter-get-thunk-maker bind-parameter)
(let ((rebind-order-no (odbc-bind-parameter-rebind-order-no bind-parameter)))
(lambda (value)
(if (= (odbc-bind-parameter-rebind-order-no bind-parameter) rebind-order-no)
(bind-parameter-get-buffer bind-parameter)
(raise-odbc-bind-parameter-rebinding-error
(odbc-bind-parameter-statement-handle bind-parameter)
(odbc-bind-parameter-parameter-no bind-parameter)
rebind-order-no
(odbc-bind-parameter-rebind-order-no bind-parameter))))))
(define (odbc-sql-bind-parameter-for-input
stmt-handle parameter-no value-type parameter-type
column-size decimal-digits)
(cond
((find-bind-parameter stmt-handle parameter-no)
=> (lambda (bind-parameter)
(set-odbc-bind-parameter-rebind-order-no!
bind-parameter (+ 1 (odbc-bind-parameter-rebind-order-no bind-parameter)))
;; do something useful here
(odbc-sql-bind-parameter-set-procedure-maker bind-parameter)))
(else
(let ((bind-parameter
(really-make-odbc-bind-parameter
(statement-handle-handle stmt-handle)
parameter-no sql-param-input value-type
parameter-type column-size decimal-digits
#f #f #f 0)))
(set-statement-handle-parameter-bindings!
stmt-handle
(cons bind-parameter (statement-handle-parameter-bindings stmt-handle)))
;; do something useful here
(odbc-sql-bind-parameter-set-procedure-maker bind-parameter)))))
(define (odbc-sql-bind-parameter-for-input-and-output
stmt-handle parameter-no value-type parameter-type
column-size decimal-digits buffer-length)
(cond
((find-bind-parameter stmt-handle parameter-no)
=> (lambda (bind-parameter)
(set-odbc-bind-parameter-rebind-order-no!
bind-parameter (+ 1 (odbc-bind-parameter-rebind-order-no bind-parameter)))
;; do something useful here
(values
(odbc-sql-bind-parameter-get-thunk-maker bind-parameter)
(odbc-sql-bind-parameter-set-procedure-maker bind-parameter))))
(else
(let ((bind-parameter
(really-make-odbc-bind-parameter
(statement-handle-handle stmt-handle)
parameter-no sql-param-input-output value-type
parameter-type column-size decimal-digits
#f #f #f 0)))
(set-statement-handle-parameter-bindings!
stmt-handle
(cons bind-parameter (statement-handle-parameter-bindings stmt-handle)))
;; do something useful here
(values
(odbc-sql-bind-parameter-get-thunk-maker bind-parameter)
(odbc-sql-bind-parameter-set-procedure-maker bind-parameter))))))
(define (odbc-sql-bind-parameter-for-output
stmt-handle parameter-no value-type parameter-type
column-size decimal-digits buffer-length)
(cond
((find-bind-parameter stmt-handle parameter-no)
=> (lambda (bind-parameter)
(set-odbc-bind-parameter-rebind-order-no!
bind-parameter (+ 1 (odbc-bind-parameter-rebind-order-no bind-parameter)))
;; do something useful here
(odbc-sql-bind-parameter-get-thunk-maker bind-parameter)))
(else
(let ((bind-parameter
(really-make-odbc-bind-parameter
(statement-handle-handle stmt-handle)
parameter-no sql-param-output value-type
parameter-type column-size decimal-digits
#f #f #f 0)))
(set-statement-handle-parameter-bindings!
stmt-handle
(cons bind-parameter (statement-handle-parameter-bindings stmt-handle)))
;; do something useful here
(odbc-sql-bind-parameter-get-thunk-maker bind-parameter)))))
(import-lambda-definition odbc-sql-bind-parameter-internal
(bind-parameter-rec)
"odbc_sql_bind_parameter")
(import-lambda-definition bind-parameter-set-buffer
(bind-parameter-rec value)
"bind_parameter_set_buffer")
(import-lambda-definition bind-parameter-get-buffer
(bind-parameter-rec)
"bind_parameter_get_buffer")
(define (odbc-sql-get-cursor-name stmt-handle) (define (odbc-sql-get-cursor-name stmt-handle)
(apply values (apply values
(odbc-sql-get-cursor-name-internal (odbc-sql-get-cursor-name-internal