+ outlined the support for SQLBindParameter()
This commit is contained in:
eknauel
parent
35f1ddd533
commit
fd4634e27f
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue