;;; ODBC handle types (define-record-type environment-handle :environment-handle (really-make-environment-handle handle) environment-handle? (handle environment-handle-handle)) (define-exported-binding "environment-handle" :environment-handle) (define-record-type connection-handle :connection-handle (really-make-connection-handle handle environment connected?) connection-handle? (handle connection-handle-handle) (environment connection-handle-environment) (connected? connection-handle-connected? set-connection-handle-connected?!)) (define-exported-binding "connection-handle" :connection-handle) (define-record-type statement-handle :statement-handle (really-make-statement-handle handle connection parameter-bindings) statement-handle? (handle statement-handle-handle) (connection statement-handle-connection) (parameter-bindings statement-handle-parameter-bindings set-statement-handle-parameter-bindings!)) (define-exported-binding "statement-handle" :statement-handle) (define-record-type descriptor-handle :descriptor-handle (really-make-descriptor-handle handle) descriptor-handle? (handle descriptor-handle-handle)) (define-exported-binding "descriptor-handle" :descriptor-handle) ; record type to store infos from SQLGetDiagRec() (define-record-type odbc-diag :odbc-diag (really-make-odbc-diag-rec sql-state native-error message) odbc-diag? (sql-state odbc-diag-sql-state) (native-error odbc-diag-native-error) (message odbc-diag-message)) (define-exported-binding "odbc-diag" :odbc-diag) (define (odbc-handle? thing) (or (environment-handle? thing) (connection-handle? thing) (statement-handle? thing) (descriptor-handle? thing))) (define (odbc-handle handle) (cond ((environment-handle? handle) (environment-handle-handle handle)) ((connection-handle? handle) (connection-handle-handle handle)) ((statement-handle? handle) (statement-handle-handle handle)) ((descriptor-handle? handle) (descriptor-handle-handle handle)) (else (error "Expected odbc-handle, got " handle odbc-handle)))) ;;; map a record to a handle type identifier (see sql.h) (define (handle-record-type->c-handle-identifier record) (cond ((environment-handle? record) 1) ; SQL_HANDLE_ENV ((connection-handle? record) 2) ; SQL_HANDLE_DBC ((statement-handle? record) 3) ; SQL_HANDLE_STMT (else (error "Unknown handle type: " record)))) ;;; conditions (define-condition-type 'odbc-error '(error)) (define odbc-error? (condition-predicate 'odbc-error)) (define-condition-type 'odbc-api-version-mismatch '(odbc-error)) (define odbc-api-version-mismatch? (condition-predicate 'odbc-api-version-mismatch)) (define (raise-odbc-api-version-mismatch-error function-name api-version api-version-needed) (apply signal 'odbc-api-version-mismatch 'function-name function-name 'odbc-driver-manager-api-version api-version 'min-api-version-required api-version-needed)) (define-exported-binding "raise-odbc-api-version-mismatch-error" raise-odbc-api-version-mismatch-error) ;;; (define-condition-type 'odbc-unknown-integer-type '(odbc-error)) (define odbc-unknown-integer-type? (condition-predicate 'odbc-unknown-integer-type)) (define (raise-odbc-unknown-integer-type-error function-name type-id) (apply signal 'odbc-unknown-integer-type 'function-name function-name 'type-id type-id)) (define-exported-binding "raise-odbc-unknown-integer-type-error" raise-odbc-unknown-integer-type-error) ;;; (define-condition-type 'odbc-buffer-alloc-error '(odbc-error)) (define odbc-buffer-alloc-error? (condition-predicate 'odbc-buffer-alloc-error)) (define (raise-odbc-buffer-alloc-error buffer-length) (apply signal 'odbc-buffer-alloc-error 'buffer-length buffer-length)) (define-exported-binding "raise-odbc-buffer-alloc-error" raise-odbc-buffer-alloc-error) ;;; (define-condition-type 'odbc-unknown-c-type-identifier-error '(odbc-error)) (define odbc-unknown-c-type-identifier-error? (condition-predicate 'odbc-unknown-c-type-identifier-error)) (define (raise-odbc-unknown-c-type-identifier-error buffer ctypeid) (apply signal 'odbc-unknown-c-type-identifier-error 'buffer buffer 'ctypeid ctypeid)) (define-exported-binding "raise-odbc-unknown-c-type-identifier-error" raise-odbc-unknown-c-type-identifier-error) ;;; (define-condition-type 'odbc-bindcol-unbound-column '(odbc-error)) (define odbc-bindcol-unbound-column-error? (condition-predicate 'odbc-bindcol-unbound-column)) (define (raise-odbc-bindcol-unbound-column-error stmt-handle column-no) (apply signal 'odbc-bindcol-unbound-column 'statement-handle stmt-handle 'column-no column-no)) (define-exported-binding "raise-odbc-bindcol-unbound-column-error" raise-odbc-bindcol-unbound-column-error) ;;; (define-condition-type 'odbc-bindcol-rebinding-error '(odbc-error)) (define odbc-bindcol-rebinding-error? (condition-predicate 'odbc-bindcol-rebinding-error)) (define (raise-odbc-bindcol-rebinding-error text-msg) (apply signal 'odbc-bindcol-rebinding-error text-msg)) (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?) odbc-column? (name odbc-column-name) (type odbc-column-type) (size odbc-column-size) (digits odbc-column-digits) (nullable? odbc-column-nullable?)) (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? (type odbc-parameter-type) (size odbc-parameter-size) (digits odbc-parameter-digits) (nullable odbc-parameter-nullable)) (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) (define sql-disconnect-opt-unbind 2) (define sql-disconnect-opt-reset-params 3) ;;; options for SQLDataSource from sql.h (define sql-datasources-fetch-next 1) (define sql-datasources-fetch-first 2) ;;; C type identifier (define sql-type-c-char 1) ; SQL_C_CHAR (define sql-type-c-long 4) ; SQL_C_LONG (define sql-type-c-short 5) ; SQL_C_SHORT (define sql-type-c-float 7) ; SQL_C_FLOAT (define sql-type-c-double 8) ; SQL_C_DOUBLE (define sql-type-c-numeric 2) ; SQL_C_NUMERIC (define sql-type-c-default 99) ; SQL_C_DEFAULT (not mentioned in Appendix D?!?!?) (define sql-type-c-date 9) ; SQL_C_DATE (define sql-type-c-time 10) ; SQL_C_TIME (define sql-type-c-timestamp 11) ; SQL_C_TIMESTAMP (define sql-type-c-binary -2) ; SQL_C_BINARY (define sql-type-c-bit -7) ; SQL_C_BIT ; missing: all the SQL_C_INTERVAL* stuff ;;; ODBC type identifier (define sql-type-unknown 0) ; SQL_UNKNOWN_TYPE (define sql-type-char 1) ; SQL_CHAR (define sql-type-numeric 2) ; SQL_NUMERIC (define sql-type-decimal 3) ; SQL_DECIMAL (define sql-type-integer 4) ; SQL_INTEGER (define sql-type-smallint 5) ; SQL_SMALLINT (define sql-type-float 6) ; SQL_FLOAT (define sql-type-real 7) ; SQL_REAL (define sql-type-double 8) ; SQL_DOUBLE (define sql-type-datetime 9) ; SQL_DATETIME (define sql-type-varchar 12) ; SQL_VARCHAR (define sql-type-date 91) ; SQL_TYPE_DATE (define sql-type-time 92) ; SQL_TYPE_TIME (define sql-type-timestamp 93) ; SQL_TYPE_TIMESTAMP (define (c-type-identifier->odbc-type-identifier c-type) (error "Not yet implemented")) (define (odbc-type-identifier->c-type-identifier odbc-type) (cond ((member odbc-type '(sql-type-char sql-type-varchar)) sql-type-c-char) ((member odbc-type '(sql-type-real sql-type-float sql-type-double)) sql-type-c-double) ((equal? odbc-type sql-type-numeric) sql-type-c-numeric) ((equal? odbc-type sql-type-decimal) (error "Can't handle type SQL_DECIMAL yet")) ((equal? odbc-type sql-type-integer) sql-type-c-long) ; ((equal? odbc-type sql-type-smallint) ; sql-type-c-smallint) ((equal? odbc-type sql-type-datetime) (error "Can't handle type SQL_DATETIME yet")) ((equal? odbc-type sql-type-date) (error "Can't handle type SQL_TYPE_DATE yet")) ((equal? odbc-type sql-type-time) (error "Can't handle type SQL_TYPE_TIME yet")) ((equal? odbc-type sql-type-timestamp) (error "Can't handle type SQL_TYPE_TIMESTAMP yet")) ((equal? odbc-type sql-type-unknown) (error "Can't handle type SQL_UNKNOWN_TYPE")) (else (error "unknown SQL type")))) ;;; ODBC function ids for SQLGetFunctions (define sql-api-sqlallocconnect 1) (define sql-api-sqlallocenv 2) (define sql-api-sqlallochandle 1001) (define sql-api-sqlallocstmt 3) (define sql-api-sqlbindcol 4) (define sql-api-sqlbinparam 1002) (define sql-api-sqlcancel 5) (define sql-api-sqlclosecursor 1003) (define sql-api-sqlcolattribute 6) (define sql-api-sqlcolumns 40) (define sql-api-sqlconnect 7) (define sql-api-sqlcopydesc 1004) (define sql-api-sqldatasources 57) (define sql-api-sqldescribecol 8) (define sql-api-sqldisconnect 9) (define sql-api-sqlendtran 1005) (define sql-api-sqlerror 10) (define sql-api-sqlexecdirect 11) (define sql-api-sqlexecute 12) (define sql-api-sqlfetch 13) (define sql-api-sqlfetchscroll 1021) (define sql-api-sqlfreeconnect 14) (define sql-api-sqlfreeenv 15) (define sql-api-sqlfreehandle 1006) (define sql-api-sqlfreestmt 16) (define sql-api-sqlgetconnectattr 1007) (define sql-api-sqlgetconenctoption 42) (define sql-api-sqlgetcursorname 17) (define sql-api-sqlgetdata 43) (define sql-api-sqlgetdescfield 1008) (define sql-api-sqlgetdescrec 1009) (define sql-api-sqlgetdiagfield 1010) (define sql-api-sqlgetdiagrec 1011) (define sql-api-sqlgetenvattr 1012) (define sql-api-sqlgetfunctions 44) (define sql-api-sqlgetinfo 45) (define sql-api-sqlgetstmtattr 1014) (define sql-api-sqlgetstmtoption 46) (define sql-api-sqlgettypeinfo 47) (define sql-api-sqlnumresultcols 18) (define sql-api-sqlparamdata 48) (define sql-api-sqlprepare 19) (define sql-api-sqlputdata 49) (define sql-api-sqlrowcount 20) (define sql-api-sqlsetconnectattr 1016) (define sql-api-sqlsetconnectoption 50) (define sql-api-sqlsetcursorname 21) (define sql-api-sqlsetdescfield 1017) (define sql-api-sqlsetdescrec 1018) (define sql-api-sqlsetenvattr 1019) (define sql-api-sqlsetparam 22) (define sql-api-sqlsetstmtattr 1020) (define sql-api-sqlsetstmtoption 51) (define sql-api-sqlspecialcolumns 52) (define sql-api-sqlstatistics 53) (define sql-api-sqltables 54) (define sql-api-transact 23) ;;; additional function identifiers (define sql-api-sqlallochandlestd 73) (define sql-api-sqlbulkoperations 24) (define sql-api-sqlbindparameter 72) (define sql-api-sqlbrowseconnect 55) (define sql-api-sqlcolattributes 6) (define sql-api-sqlcolumnprivileges 56) (define sql-api-sqldescribeparam 58) (define sql-api-sqldriverconnect 41) (define sql-api-sqldrivers 71) (define sql-api-sqlextendedfetch 59) (define sql-api-sqlforeignkeys 60) (define sql-api-sqlmoreresults 61) (define sql-api-sqlnativesql 62) (define sql-api-sqlnumparams 63) (define sql-api-sqlparamoptions 64) (define sql-api-sqlprimarykeys 65) (define sql-api-sqlprocedurecolumns 66) (define sql-api-sqlprcoedures 67) (define sql-api-sqlsetpos 68) (define sql-api-sqlsetscrolloptions 69) (define sql-api-sqltableprivileges 70) ;;; info keys for odbc-sql-get-info-arg-int/string ; ODBC 1.0, returns integer (define sql-get-info-arg-maxdriverconnections 0) ; ODBC 1.0, returns integer (define sql-get-info-arg-maxconcurrentactivities 1) ; ODBC 1.0, returns string (define sql-get-info-arg-datasourcename 2) ; deprecated in ODBC 3.x returns ? (define sql-get-info-arg-fetchdirection 8) ; ODBC 1.0, returns string (define sql-get-info-arg-servername 13) ; ODBC 1.0, returns string (define sql-get-info-arg-searchpatternescape 14) ; ODBC 1.0, returns string (define sql-get-info-arg-dbmsname 17) ; ODBC 1.0, returns string (define sql-get-info-arg-dbmsver 18) ; ODBC 1.0, returns string (define sql-get-info-arg-accessibletables 19) ; ODBC 1.0, returns string (define sql-get-info-arg-accessibaleprocedures 20) ; ODBC 1.0, returns integer (define sql-get-info-arg-cursor-commit-behaviour 23) ; ODBC 1.0, returns string (define sql-get-info-arg-datasourcereadonly 25) ; ODBC 1.0, returns integer (define sql-get-info-arg-defaulttxnisolation 26) ; ODBC 1.0, returns integer (define sql-get-info-arg-identifiercase 28) ; ODBC 1.0, returns string (define sql-get-info-arg-identifierquotechar 29) ; ODBC 1.0 returns integer (define sql-get-info-arg-maxcolumnnamelen 30) (define sql-get-info-arg-maximumcolumnnamelen 30) ; ODBC 1.0 returns integer (define sql-get-info-arg-maxcursornamelen 31) (define sql-get-info-arg-maximumcursornamelen 31) ; ODBC 1.0 returns integer (define sql-get-info-arg-maxschemanamelen 32) (define sql-get-info-arg-maximumschemenamelen 32) ; ODBC 1.0 returns integer (define sql-get-info-arg-maxcatalognamelen 34) (define sql-get-info-arg-maximumcatalognamelen 34) ; ODBC 1.0 returns integer (define sql-get-info-arg-maxtablenamelen 35) ; defined in sql.h, but no reference in ODBC manual ; (define sql-get-info-arg--scrollconcurrency 43) ; ODBC 1.0 returns integer (define sql-get-info-arg-txncapable 46) (define sql-get-info-arg-transaction-capable 46) ; ODBC 1.0 returns string (define sql-get-info-arg-username 47) ; ODBC 1.0 returns integer (define sql-get-info-arg-txnisolationoption 72) (define sql-get-info-arg-transcationisolationoption 72) ; ODBC 1.0 returns string (define sql-get-info-arg-integrity 73) ; ODBC 2.0 returns integer (define sql-get-info-arg-getdataextensions 81) ; ODBC 2.0 returns integer (define sql-get-info-arg-nullcollation 85) ; ODBC 2.0 returns integer (define sql-get-info-arg-altertable 86) ; ODBC 2.0 returns string (define sql-get-info-arg-specialcharacters 94) ; ODBC 2.0 returns integer (define sql-get-info-arg-maxcolumnsingroupby 97) (define sql-get-info-arg-maximumcolumnsingroupby 97) ; ODBC 2.0 returns integer (define sql-get-info-arg-maxcolumnsinindex 98) (define sql-get-info-arg-maximumcolumnsinindex 98) ; ODBC 2.0 returns integer (define sql-get-info-arg-maxcolumnsinorderby 99) (define sql-get-info-arg-maximumcolumnsinorderby 99) ; ODBC 2.0 returns integer (define sql-get-info-arg-maxcolumnsinselect 100) (define sql-get-info-arg-maximumcolumnsinselect 100) ; ODBC 2.0 returns integer (define sql-get-info-arg-maxcolumnsintable 101) ; ODBC 2.0 returns integer (define sql-get-info-arg-maxindexsize 102) (define sql-get-info-arg-maximumindexsize 102) ; ODBC 2.0 returns integer (define sql-get-info-arg-maxrowsize 104) (define sql-get-info-arg-maximumrowsize 104) ; ODBC 2.0 returns integer (define sql-get-info-arg-maxstatementlen 105) (define sql-get-info-arg-maximumstatemenlen 105) ; ODBC 2.0 returns integer (define sql-get-info-arg-maxtablesinselect 106) (define sql-get-info-arg-maximumtablesinselect 106) ; ODBC 2.0 returns integer (define sql-get-info-arg-maxusernamelen 107) (define sql-get-info-arg-maximumusernamelen 107) ; ODBC 2.01 returns integer (define sql-get-info-arg-ojcapabilities 115) (define sql-get-info-arg-outerjoincapabilities 115) ; ODBC return values for SQLGetInfo sql-get-info-arg-identifiercase (SQL_IDENTIFIER_CASE) (define sql-ic-upper 1) (define sql-ic-lower 2) (define sql-ic-sensitive 3) (define sql-ic-mixed 4) ; ODBC return values for SQLGetInfo sql-get-info-arg-defaulttxnisolation (SQL_DEFAULT_TXN_ISOLATION) (define sql-txn-read-uncommited #x00000001) (define sql-txn-read-committed #x00000002) (define sql-txn-repeatable-read #x00000004) (define sql-txn-serializable #x00000008) ; ODBC return values for SQLGetInfo sql-get-info-arg-txncapable (SQL_TXN_CAPABLE) (define sql-tc-none 0) (define sql-tc-dml 1) (define sql-tc-all 2) (define sql-tc-ddl-commit 3) (define sql-tc-ddl-ignore 4) ; ODBC return values for SQLGetInfo sql-get-info-arg-getdataextensions (SQL_GETDATA_EXTENSIONS) (define sql-gd-any-column #x00000001) (define sql-gd-any-order #x00000002) (define sql-gd-block #x00000004) (define sql-gd-bound #x00000008) ; ODBC return values for SQLGetInfo sql-get-info-arg-nullcollation (SQL_NULL_COLLATION) (define sql-nc-end #x0004) (define sql-nc-start #x0002) ; missing sql-nc-high sql-nc-low ; ODBC return values for SQLGetInfo sql-get-info-arg-altertable (SQL_ALTER_TABLE) (define sql-at-add-colum #x00000001) (define sql-at-drop-column #x00000002) (define sql-at-add-constraint #x00000008) (define sql-at-add-column-single #x00000020) (define sql-at-add-column-default #x00000040) (define sql-at-add-column-collation #x00000080) (define sql-at-set-column-default #x00000100) (define sql-at-drop-column-default #x00000200) (define sql-at-drop-column-cascade #x00000400) (define sql-at-drop-column-restrict #x00000800) (define sql-at-drop-table-constraint #x00001000) (define sql-at-drop-table-constraint-cascade #x00002000) (define sql-at-drop-table-constraint-restrict #x00004000) (define sql-at-constraint-name-definition #x00008000) (define sql-at-constraint-initially-deferred #x00010000) (define sql-at-constraint-initially-immediate #x00020000) (define sql-at-constraint-deferrable #x00040000) (define sql-at-constraint-non-deferrable #x00080000) ; ODBC return values for SQLGetInfo sql-get-info-arg-ojcapabilities (SQL_OJ_CAPABILITIES) (define sql-oj-left #x00000001) (define sql-oj-right #x00000002) (define sql-oj-full #x00000004) (define sql-oj-nested #x00000008) (define sql-oj-not-ordered #x00000010) (define sql-oj-inner #x00000020) (define sql-oj-all-comparison-ops #x00000040) ; ODBC data types for use with odbc_sql_get_type_info (define sql-datatype-unknown 0) (define sql-datatype-char 1) (define sql-datatype-numeric 2) (define sql-datatype-decimal 3) (define sql-datatype-integer 4) (define sql-datatype-smallint 5) (define sql-datatype-float 6) (define sql-datatype-real 7) (define sql-datatype-double 8) (define sql-datatype-datetime 9) (define sql-datatype-interval 10) (define sql-datatype-varchar 12) (define sql-datatype-date 91) (define sql-datatype-time 92) (define sql-datatype-timestamp 93) ; possible identifier-type arguments for SQLSpecialColumns() (odbc-sql-special-columns) (define sql-best-rowid 1) (define sql-rowver 2) ; possible scope arguments for SQLSpecialColumns() (odbc-sql-special-columns) (define sql-scope-currow 0) (define sql-scope-transaction 1) (define sql-scope-session 2) ; possible nullable arguments for SQLSpecialColumns() (odbc-sql-special-columns) (define sql-no-nulls 0) (define sql-nullable 1) ; possible unique arguments for SQLStatistics() (odbc-sql-statistics) (define sql-index-unique 0) (define sql-index-all 1) ; possible reserved arguments for SQLStatistics() (odbc-sql-statistics) (define sql-ensure 1) (define sql-quick 0) ; possible operation arguments for SQLSetPos() (odbc-sql-set-pos) (define sql-position 0) (define sql-refresh 1) (define sql-update 2) (define sql-delete 3) ; possible lock-type arguments for SQLSetPos() (odbc-sql-set-pos) (define sql-lock-no-change 0) (define sql-lock-exclusive 1) (define sql-lock-unlock 2) ; possible operation arguments for SQLBulkOperations() (odbc-sql-bulk-operations) (define sql-add 4) (define sql-update-by-bookmark 5) (define sql-delete-by-bookmark 6) (define sql-fetch-by-bookmark 7) ;;; ODBC return values (define sql-error -1) (define sql-success 0) (define sql-success-with-info 1) (define sql-no-data 100) (define sql-invalid-handle -2) (define sql-need-data 99) ;;; PART 1 (define (odbc-alloc-environment-handle) (let* ((status.value (odbc-alloc-environment-handle-internal)) (status (car status.value)) (value (cadr status.value))) (if (odbc-call-successful? status) (let ((env-handle (really-make-environment-handle value))) (add-finalizer! env-handle odbc-sql-free-handle) (values status env-handle)) (values status value)))) (import-lambda-definition odbc-alloc-environment-handle-internal () "odbc_alloc_environment_handle") (define (odbc-alloc-connection-handle env-handle) (let* ((status.value (odbc-alloc-connection-handle-internal (environment-handle-handle env-handle))) (status (car status.value)) (value (cadr status.value))) (if (odbc-call-successful? status) (let ((conn-handle (really-make-connection-handle value env-handle #f))) (add-finalizer! conn-handle free-connection-handle) (values status conn-handle)) (values status value)))) (import-lambda-definition odbc-alloc-connection-handle-internal (env-handle) "odbc_alloc_connection_handle") ;;; maybe we should raise a warning like "implicit connect" here? (define (free-connection-handle conn-handle) (if (connection-handle-connected? conn-handle) (odbc-sql-disconnect conn-handle)) (odbc-sql-free-handle conn-handle)) (define (odbc-alloc-statement-handle conn-handle) (let* ((status.value (odbc-alloc-statement-handle-internal (connection-handle-handle conn-handle))) (status (car status.value)) (value (cadr status.value))) (if (odbc-call-successful? status) (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)) (import-lambda-definition odbc-alloc-statement-handle-internal (db-handle) "odbc_alloc_statement_handle") (import-lambda-definition bindcol-finalize-bindcols (stmt-handle) "bindcol_finalize_bindcols") ;;; returns odbc-return-value (define (odbc-sql-connect conn-handle server-name user-name auth) (let ((return-value (odbc-sql-connect-internal (connection-handle-handle conn-handle) server-name user-name auth))) (if (odbc-call-successful? return-value) (set-connection-handle-connected?! conn-handle #t)) return-value)) (import-lambda-definition odbc-sql-connect-internal (conn-handle server-name user-name auth) "odbc_sql_connect") (define (odbc-sql-browse-connect conn-handle connection-string) (apply values (odbc-sql-browse-connect-internal (connection-handle-handle conn-handle) connection-string))) (import-lambda-definition odbc-sql-browse-connect-internal (conn-handle connection-string) "odbc_sql_browse_connect") ;;; PART 2 (define (odbc-sql-data-sources env-handle) (apply values (odbc-sql-data-sources-internal (environment-handle-handle env-handle)))) (import-lambda-definition odbc-sql-data-sources-internal (env-handle) "odbc_sql_data_sources") (define (odbc-sql-drivers env-handle) (apply values (odbc-sql-drivers-internal (environment-handle-handle env-handle)))) (import-lambda-definition odbc-sql-drivers-internal (env-handle) "odbc_sql_drivers") (define (odbc-sql-get-info-int conn-handle info-key) (apply values (odbc-sql-get-info-int-internal (connection-handle-handle conn-handle) info-key))) (import-lambda-definition odbc-sql-get-info-int-internal (conn-handle info-key) "odbc_sql_get_info_int") (define (odbc-sql-get-info-string conn-handle info-key) (apply values (odbc-sql-get-info-string-internal (connection-handle-handle conn-handle) info-key))) (import-lambda-definition odbc-sql-get-info-string-internal (conn-handle info-key) "odbc_sql_get_info_string") (define (odbc-sql-get-func conn-handle fun-id) (apply values (odbc-sql-get-func-exists-internal (connection-handle-handle conn-handle) fun-id))) (import-lambda-definition odbc-sql-get-func-exists-internal (conn-handle fun-id) "odbc_sql_get_func_exists") (define (odbc-sql-get-type-info stmt-handle data-type) (odbc-sql-get-type-info-internal (statement-handle-handle stmt-handle) data-type)) (import-lambda-definition odbc-sql-get-type-info-internal (stmt-handle data-type) "odbc_sql_get_type_info") ;;; PART 3 (define (odbc-sql-set-connect-attr-int conn-handle attribute value pass-by-reference?) (odbc-sql-set-connect-attr-int-internal (connection-handle-handle conn-handle) attribute value pass-by-reference?)) (import-lambda-definition odbc-sql-set-connect-attr-int-internal (conn-handle attribute value pass-by-reference?) "odbc_sql_set_connect_attr_int") (define (odbc-sql-set-connect-attr-string conn-handle attribute value) (odbc-sql-set-connect-attr-string-internal (connection-handle-handle conn-handle) attribute value)) (import-lambda-definition odbc-sql-set-connect-attr-string-internal (conn-handle attribute value) "odbc_sql_set_connect_attr_string") (define (odbc-sql-get-connect-attr-string conn-handle attribute) (apply values (odbc-sql-get-connect-attr-string-internal (connection-handle-handle conn-handle) attribute))) (import-lambda-definition odbc-sql-get-connect-attr-string-internal (conn-handle attribute) "odbc_sql_get_connect_attr_string") (define (odbc-sql-get-connect-attr-int conn-handle attribute) (apply values (odbc-sql-get-connect-attr-int-internal (connection-handle-handle conn-handle) attribute))) (import-lambda-definition odbc-sql-get-connect-attr-int-internal (conn-handle attribute) "odbc_sql_get_connect_attr_int") (define (odbc-sql-set-env-attr-int env-handle attribute value pass-by-reference?) (odbc-sql-set-env-attr-int-internal (environment-handle-handle env-handle) attribute value pass-by-reference?)) (import-lambda-definition odbc-sql-set-env-attr-int-internal (env-handle attribute value pass-by-reference?) "odbc_sql_set_env_attr_int") (define (odbc-sql-get-env-attr-int env-handle attribute value) (apply values (odbc-sql-get-env-attr-int-internal (environment-handle-handle env-handle) attribute value))) (import-lambda-definition odbc-sql-get-env-attr-int-internal (env-handle attribute value) "odbc_sql_get_env_attr_int") (define (odbc-sql-set-stmt-attr-int stmt-handle attribute value pass-by-reference?) (odbc-sql-set-stmt-attr-int-internal (statement-handle-handle stmt-handle) attribute value pass-by-reference?)) (import-lambda-definition odbc-sql-set-stmt-attr-int-internal (stmt-handle attribute value pass-by-reference?) "odbc_sql_set_stmt_attr_int") (define (odbc-sql-set-stmt-attr-string stmt-handle attribute value) (odbc-sql-set-stmt-attr-string-internal (statement-handle-handle stmt-handle) attribute value)) (import-lambda-definition odbc-sql-set-stmt-attr-string-internal (stmt-handle attribute value) "odbc_sql_set_stmt_attr_string") (define (odbc-sql-get-stmt-attr-int stmt-handle attribute) (apply values (odbc-sql-get-stmt-attr-int-internal (statement-handle-handle stmt-handle) attribute))) (import-lambda-definition odbc-sql-get-stmt-attr-int-internal (stmt-handle attribute) "odbc_sql_get_stmt_attr_int") (define (odbc-sql-get-stmt-attr-string stmt-handle attribute) (apply values (odbc-sql-get-stmt-attr-string-internal (statement-handle-handle stmt-handle) attribute))) (import-lambda-definition odbc-sql-get-stmt-attr-string-internal (stmt-handle attribute) "odbc_sql_get_stmt_attr_string") ;;; PART 4 (define (odbc-sql-get-desc-field-int desc-handle record-number field-id) (apply values (odbc-sql-get-desc-field-int-internal (descriptor-handle-handle desc-handle) record-number field-id))) (import-lambda-definition odbc-sql-get-desc-field-int-internal (desc-handle record-number field-id) "odbc_sql_get_desc_field_int") (define (odbc-sql-get-desc-field-string desc-handle record-number field-id) (apply values (odbc-sql-get-desc-field-string-internal (descriptor-handle-handle desc-handle) record-number field-id))) (import-lambda-definition odbc-sql-get-desc-field-string-internal (desc-handle record-number field-id) "odbc_sql_get_desc_field_string") ;;; PART 5 (define (odbc-sql-prepare stmt-handle stmt-txt) (odbc-sql-prepare-internal (statement-handle-handle stmt-handle) stmt-txt)) (import-lambda-definition odbc-sql-prepare-internal (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) ;; rebind this 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 (statement-handle-handle stmt-handle)))) (import-lambda-definition odbc-sql-get-cursor-name-internal (stmt-handle) "odbc_sql_get_cursor_name") (define (odbc-sql-set-cursor-name stmt-handle cursor-name) (odbc-sql-set-cursor-name-internal (statement-handle-handle stmt-handle) cursor-name)) (import-lambda-definition odbc-sql-set-cursor-name-internal (stmt-handle cursor-name) "odbc_sql_set_cursor_name") ;;; PART 6 (define (odbc-sql-execute stmt-handle) (odbc-sql-execute-internal (statement-handle-handle stmt-handle))) (import-lambda-definition odbc-sql-execute-internal (stmt-handle) "odbc_sql_execute") (define (odbc-sql-execute-direct stmt-handle stmt-txt) (odbc-sql-execute-direct-internal (statement-handle-handle stmt-handle) stmt-txt)) (import-lambda-definition odbc-sql-execute-direct-internal (stmt-handle stmt-txt) "odbc_sql_execute_direct") (define (odbc-sql-native-sql conn-handle stmt-txt) (apply values (odbc-sql-native-sql-internal (connection-handle-handle conn-handle) stmt-txt))) (import-lambda-definition odbc-sql-native-sql-internal (conn-handle stmt-txt) "odbc_sql_native_sql") (define (odbc-sql-describe-param stmt-handle parameter-no) (apply values (odbc-sql-describe-param-internal (statement-handle-handle stmt-handle) parameter-no))) (import-lambda-definition odbc-sql-describe-param-internal (stmt-handle parameter-no) "odbc_sql_describe_param") (define (odbc-sql-num-params stmt-handle) (apply values (odbc-sql-num-params-internal (statement-handle-handle stmt-handle)))) (import-lambda-definition odbc-sql-num-params-internal (stmt-handle) "odbc_sql_num_params") ;;; PART 7 (define (odbc-sql-row-count stmt-handle) (apply values (odbc-sql-row-count-internal (statement-handle-handle stmt-handle)))) (import-lambda-definition odbc-sql-row-count-internal (stmt-handle) "odbc_sql_row_count") (define (odbc-sql-get-data stmt-handle column-number target-type) (apply values (odbc-sql-get-data-internal (statement-handle-handle stmt-handle) column-number target-type))) (import-lambda-definition odbc-sql-get-data-internal (stmt-handle column-number target-type) "odbc_sql_get_data") (define (odbc-sql-set-pos stmt-handle row-number operation lock-type) (odbc-sql-set-pos-internal (statement-handle-handle stmt-handle) row-number operation lock-type)) (import-lambda-definition odbc-sql-set-pos-internal (stmt-handle row-number operation lock-type) "odbc_sql_set_pos") (define (odbc-sql-bulk-operations stmt-handle operation) (odbc-sql-bulk-operations-internal (statement-handle-handle stmt-handle) operation)) (import-lambda-definition odbc-sql-bulk-operations-internal (stmt-handle operation) "odbc_sql_bulk_operations") (define (odbc-sql-more-results stmt-handle) (odbc-sql-more-results-internal (statement-handle-handle stmt-handle))) (import-lambda-definition odbc-sql-more-results-internal (stmt-handle) "odbc_sql_more_results") (define (odbc-sql-fetch stmt-handle) (odbc-sql-fetch-internal (statement-handle-handle stmt-handle))) (import-lambda-definition odbc-sql-fetch-internal (stmt-handle) "odbc_sql_fetch") (define (odbc-sql-bindcol stmt-handle column-no target-type buffer-len) (let ((handle (statement-handle-handle stmt-handle))) (odbc-sql-bindcol-internal handle column-no target-type buffer-len) (lambda () (bindcol-lookup-binding-scheme handle column-no)))) (import-lambda-definition odbc-sql-bindcol-internal (stmt-handle column-no target-type buffer-len) "odbc_sql_bindcol") (import-lambda-definition bindcol-lookup-binding-scheme (stmt-handle column-no) "bindcol_lookup_binding_scheme") ;;; PART 8 (define (odbc-sql-column-privileges stmt-handle catalog-name schema-name table-name column-name) (check-arg statement-handle? stmt-handle odbc-sql-column-privileges) (odbc-sql-column-privileges-internal (statement-handle-handle stmt-handle) catalog-name schema-name table-name column-name)) (import-lambda-definition odbc-sql-column-privileges-internal (stmt-handle catalog-name schema-name table-name column-name) "odbc_sql_column_privileges") (define (odbc-sql-columns stmt-handle catalog-name schema-name table-name column-name) (check-arg statement-handle? stmt-handle odbc-sql-columns) (odbc-sql-columns-internal (statement-handle-handle stmt-handle) catalog-name schema-name table-name column-name)) (import-lambda-definition odbc-sql-columns-internal (stmt-handle catalog-name schema-name table-name column-name) "odbc_sql_columns") (define (odbc-sql-foreign-keys stmt-handle pk-catalog-name pk-schema-name pk-table-name fk-catalog-name fk-schema-name fk-table-name) (check-arg statement-handle? stmt-handle odbc-sql-foreign-keys) (odbc-sql-foreign-keys-internal (statement-handle-handle stmt-handle) pk-catalog-name pk-schema-name pk-table-name fk-catalog-name fk-schema-name fk-table-name)) (import-lambda-definition odbc-sql-foreign-keys-internal (stmt-handle pk-catalog-name pk-schema-name pk-table-name fk-catalog-name fk-schema-name fk-table-name) "odbc_sql_foreign_keys") (define (odbc-sql-primary-keys stmt-handle catalog-name schema-name table-name) (check-arg statement-handle? stmt-handle odbc-sql-primary-keys) (odbc-sql-primary-keys-internal (statement-handle-handle stmt-handle) catalog-name schema-name table-name)) (import-lambda-definition odbc-sql-primary-keys-internal (stmt-handle catalog-name schema-name table-name) "odbc_sql_primary_keys") (define (odbc-sql-procedure-columns stmt-handle catalog-name schema-name proc-name column-name) (check-arg statement-handle? stmt-handle odbc-sql-procedure-columns) (odbc-sql-procedure-columns-internal (statement-handle-handle stmt-handle) catalog-name schema-name proc-name column-name)) (import-lambda-definition odbc-sql-procedure-columns-internal (stmt-handle catalog-name schema-name proc-name column-name) "odbc_sql_procedure_columns") (define (odbc-sql-procedures stmt-handle catalog-name schema-name proc-name) (check-arg statement-handle? stmt-handle odbc-sql-procedures) (odbc-sql-procedures-internal (statement-handle-handle stmt-handle) catalog-name schema-name proc-name)) (import-lambda-definition odbc-sql-procedures-internal (stmt-handle catalog-name schema-name proc-name) "odbc_sql_procedures") (define (odbc-sql-special-columns stmt-handle identifier-type catalog-name schema-name table-name scope nullable) (check-arg statement-handle? stmt-handle odbc-sql-special-columns) (odbc-sql-special-columns-internal (statement-handle-handle stmt-handle) identifier-type catalog-name schema-name table-name schema-name nullable)) (import-lambda-definition odbc-sql-special-columns-internal (stmt-handle identifier-type catalog-name schema-name table-name scope nullable?) "odbc_sql_special_columns") (define (odbc-sql-statistics stmt-handle catalog-name schema-name table-name unique reserved) (check-arg statement-handle? stmt-handle odbc-sql-statistics) (odbc-sql-statistics-internal (statement-handle-handle stmt-handle) catalog-name schema-name table-name unique reserved)) (import-lambda-definition odbc-sql-statistics-internal (stmt-handle catalog-name schema-name table-name unique reserved) "odbc_sql_statistics") (define (odbc-sql-table-privileges stmt-handle catalog-name schema-name table-name) (check-arg statement-handle? stmt-handle odbc-sql-table-privileges) (odbc-sql-table-privileges-internal (statement-handle-handle stmt-handle) catalog-name schema-name table-name)) (import-lambda-definition odbc-sql-table-privileges-internal (stmt-handle catalog-name schema-name table-name) "odbc_sql_table_privileges") (define (odbc-sql-tables stmt-handle catalog-name schema-name table-name table-type) (check-arg statement-handle? stmt-handle odbc-sql-tables) (odbc-sql-tables-internal (statement-handle-handle stmt-handle) catalog-name schema-name table-name table-type)) (import-lambda-definition odbc-sql-tables-internal (stmt-handle catalog-name schema-name table-type table-type) "odbc_sql_tables") ;;; PART 9 (define (odbc-sql-free-statement stmt-handle option) (check-arg statement-handle? stmt-handle odbc-sql-free-statement) (odbc-sql-free-statement-internal (statement-handle-handle stmt-handle) option)) (import-lambda-definition odbc-sql-free-statement-internal (stmt-handle option) "odbc_sql_free_statement") (define (odbc-sql-close-cursor stmt-handle) (check-arg statement-handle? stmt-handle odbc-sql-close-cursor) (odbc-sql-close-cursor-internal (statement-handle-handle stmt-handle))) (import-lambda-definition odbc-sql-close-cursor-internal (stmt-handle) "odbc_sql_close_cursor") (define (odbc-sql-cancel stmt-handle) (check-arg statement-handle? stmt-handle odbc-sql-cancel) (odbc-sql-cancel-internal (statement-handle-handle stmt-handle))) (import-lambda-definition odbc-sql-cancel-internal (stmt-handle) "odbc_sql_cancel") (define (odbc-sql-num-result-cols stmt-handle) (check-arg statement-handle? stmt-handle odbc-sql-num-result-cols) (odbc-sql-num-result-cols-internal (statement-handle-handle stmt-handle))) (import-lambda-definition odbc-sql-num-result-cols-internal (stmt-handle) "odbc_sql_num_result_cols") (define (odbc-sql-describe-col stmt-handle column-number) (check-arg statement-handle? stmt-handle odbc-sql-describe-col) (odbc-sql-describe-col-internal (statement-handle-handle stmt-handle) column-number)) (import-lambda-definition odbc-sql-describe-col-internal (stmt-handle column-number) "odbc_sql_describe_col") (define (odbc-sql-col-attribute stmt-handle column-number field-id) (check-arg statement-handle? stmt-handle odbc-sql-col-attribute) (let ((pair (odbc-sql-col-attribute-internal (statement-handle-handle stmt-handle) column-number field-id))) (if (zero? (string-length (car pair))) (cdr pair) (car pair)))) (import-lambda-definition odbc-sql-col-attribute-internal (stmt-handle column-number field-id) "odbc_sql_col_attribute") ;;; PART 10 (define (odbc-sql-disconnect conn-handle) (check-arg connection-handle? conn-handle odbc-sql-disconnect) (let ((return-value (odbc-sql-disconnect-internal (connection-handle-handle conn-handle)))) (if (odbc-call-successful? return-value) (set-connection-handle-connected?! conn-handle #f)) return-value)) (import-lambda-definition odbc-sql-disconnect-internal (conn-handle) "odbc_sql_disconnect") (define (odbc-sql-free-handle handle) (check-arg odbc-handle? handle odbc-sql-free-handle) (odbc-sql-free-handle-internal (handle-record-type->c-handle-identifier handle) (odbc-handle handle))) (import-lambda-definition odbc-sql-free-handle-internal (handle-type handle) "odbc_sql_free_handle") (define (odbc-sql-get-diag-recs handle) (apply values (odbc-sql-get-diag-recs-internal (handle-record-type->c-handle-identifier handle) (odbc-handle handle)))) (import-lambda-definition odbc-sql-get-diag-recs-internal (handle-type handle) "odbc_sql_get_diag_recs") (import-lambda-definition odbc-set-initial-retval-buffer-size (no-bytes) "odbc_set_initial_retval_buffer_size") (import-lambda-definition odbc-get-initial-retval-buffer-size () "odbc_get_intial_retval_buffer_size") ;;; misc stuff (define (odbc-call-successful? odbc-return-value) (or (equal? odbc-return-value sql-success) (equal? odbc-return-value sql-success-with-info)))