+ outlined the support for SQLBindParameter()

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
+   srfi-1 define-record-types
-   conditions signals)
+   conditions signals
+   low-odbc-constants)
   (files odbc))
 
 (define-structure low-odbc-constants low-odbc-constants-interface

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);
 

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);

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