From fd4634e27f91d6af5bd76dbe377dc8d48f19e7df Mon Sep 17 00:00:00 2001 From: eknauel Date: Mon, 28 Apr 2003 12:33:02 +0000 Subject: [PATCH] + outlined the support for SQLBindParameter() --- scsh/odbc/odbc-packages.scm | 5 +- scsh/odbc/odbc.c | 76 ++++++++++++++++- scsh/odbc/odbc.h | 20 +++++ scsh/odbc/odbc.scm | 158 +++++++++++++++++++++++++++++++++++- 4 files changed, 251 insertions(+), 8 deletions(-) diff --git a/scsh/odbc/odbc-packages.scm b/scsh/odbc/odbc-packages.scm index 7931254..6fc9cda 100644 --- a/scsh/odbc/odbc-packages.scm +++ b/scsh/odbc/odbc-packages.scm @@ -1,8 +1,9 @@ (define-structure low-odbc low-odbc-interface (open scheme external-calls scsh-utilities - define-record-types - conditions signals) + srfi-1 define-record-types + conditions signals + low-odbc-constants) (files odbc)) (define-structure low-odbc-constants low-odbc-constants-interface diff --git a/scsh/odbc/odbc.c b/scsh/odbc/odbc.c index 8bc9f6a..8821e8b 100644 --- a/scsh/odbc/odbc.c +++ b/scsh/odbc/odbc.c @@ -412,7 +412,7 @@ s48_value odbc_sql_set_connect_attr_int(s48_value conn_handle, ch = (SQLHDBC) s48_extract_integer(conn_handle); attr = (SQLINTEGER) s48_extract_integer(attribute); val = (SQLUINTEGER) s48_extract_integer(value); - retval = SQLSetConnectAttr(ch, attr, &val, 0); + retval = SQLSetConnectAttr(ch, attr, (SQLPOINTER) &val, 0); return s48_enter_integer(retval); #else @@ -774,7 +774,71 @@ s48_value odbc_sql_prepare(s48_value stmt_handle, s48_value stmt_txt) 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) { @@ -2182,7 +2246,10 @@ void s48_init_odbc(void) odbc_column_record_type = s48_get_imported_binding("odbc-column"); 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); bindcol_buffer_record_type = s48_get_imported_binding("bindcol-buffer"); @@ -2248,6 +2315,9 @@ void s48_init_odbc(void) /* PART 5 */ 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_set_cursor_name); diff --git a/scsh/odbc/odbc.h b/scsh/odbc/odbc.h index 5251377..c01eaca 100644 --- a/scsh/odbc/odbc.h +++ b/scsh/odbc/odbc.h @@ -129,6 +129,20 @@ static s48_value odbc_parameter_record_type = S48_FALSE; #define SR_ODBC_PARAMETER_DIGITS 2 #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() */ /* 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 */ 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_set_cursor_name(s48_value stmt_handle, s48_value cursorname); diff --git a/scsh/odbc/odbc.scm b/scsh/odbc/odbc.scm index c63e776..64d4c6a 100644 --- a/scsh/odbc/odbc.scm +++ b/scsh/odbc/odbc.scm @@ -16,10 +16,12 @@ (define-exported-binding "connection-handle" :connection-handle) (define-record-type statement-handle :statement-handle - (really-make-statement-handle handle connection) + (really-make-statement-handle handle connection parameter-bindings) statement-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) @@ -150,6 +152,19 @@ (define-exported-binding "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 (really-make-odbc-column name type size digits nullable?) @@ -162,6 +177,7 @@ (define-exported-binding "odbc-column" :odbc-column) +;;; parameter descriptions (returned by SQLDescribeParams()) (define-record-type odbc-parameter :odbc-parameter (really-make-odbc-parameter type size digits nullable) odbc-parameter? @@ -172,6 +188,26 @@ (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 (define sql-disconnect-opt-close 0) (define sql-disconnect-opt-drop 1) @@ -587,11 +623,12 @@ (status (car status.value)) (value (cadr status.value))) (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) (values status stmt-handle)) (values status value)))) +;;; FIXME: free parameter-bindings, dealloc buffers (define (free-statement-handle stmt-handle) (bindcol-finalize-bindcols (statement-handle-handle stmt-handle)) (odbc-sql-free-handle stmt-handle)) @@ -798,6 +835,121 @@ (stmt-handle stmt-txt) "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) (apply values (odbc-sql-get-cursor-name-internal