scsh-0.6/scsh/odbc/odbc.scm

513 lines
15 KiB
Scheme

;;; handle type identifiers from sql.h
(define handle-type-env 1)
(define handle-type-dbc 2)
(define handle-type-stmt 3)
(define handle-type-desc 4)
;;; 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)
(define sql-type-c-long 4)
(define sql-type-c-short 5)
(define sql-type-c-float 7)
(define sql-type-c-double 8)
(define sql-type-c-numeric 2)
(define sql-type-c-default 99)
(define sql-type-c-date 9)
(define sql-type-c-time 10)
(define sql-type-c-timestamp 11)
(define sql-type-c-binary -2)
(define sql-type-c-bit -7)
;;; ODBC type identifier
(define sql-type-unknown 0)
(define sql-type-char 1)
(define sql-type-numeric 2)
(define sql-type-decimal 3)
(define sql-type-integer 4)
(define sql-type-smallint 5)
(define sql-type-float 6)
(define sql-type-real 7)
(define sql-type-double 8)
(define sql-type-datetime 9)
(define sql-type-varchar 12)
(define sql-type-date 91)
(define sql-type-time 92)
(define sql-type-timestamp 93)
;;; 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-int/string
;;; TODO: sort on return value type!
(define sql-get-info-maxdriverconnections 0)
(define sql-get-info-maximumdriverconnections 0)
(define sql-get-info-maxconcurrentactivities 1)
(define sql-get-info-maximumconcurrentactivities 1)
(define sql-get-info-datasourcename 2)
(define sql-get-info-fetchdirection 8)
(define sql-get-info-servername 13)
(define sql-get-info-searchpatternescape 14)
(define sql-get-info-dbmsname 17)
(define sql-get-info-dbmsver 18)
(define sql-get-info-accessibletable 19)
(define sql-get-info-accessibaleprocedures 20)
(define sql-get-info-cursor-commit-behaviour 23)
(define sql-get-info-datasourcereadonly 25)
(define sql-get-info-defaulttxnisolation 26)
(define sql-get-info-identifiercase 28)
(define sql-get-info-identifierquotechar 29)
(define sql-get-info-maxcolumnnamelen 30)
(define sql-get-info-maximumcolumnnamelen 30)
(define sql-get-info-maxcursornamelen 31)
(define sql-get-info-maximumcursornamelen 31)
(define sql-get-info-maxschemanamelen 32)
(define sql-get-info-maximumschemenamelen 32)
(define sql-get-info-maxcatalognamelen 34)
(define sql-get-info-maximumcatalognamelen 34)
(define sql-get-info-maxtablenamelen 35)
(define sql-get-info-scrollconcurrency 43)
(define sql-get-info-txncapable 46)
(define sql-get-info-transaction-capable 46)
(define sql-get-info-username 47)
(define sql-get-info-txpisolationoption 72)
(define sql-get-info-transcationisolationoption 72)
(define sql-get-info-integrity 73)
(define sql-get-info-getdataextensions 81)
(define sql-get-info-nullcollation 85)
(define sql-get-info-altertable 86)
(define sql-get-info-specialcharacters 94)
(define sql-get-info-maxcolumnsingroupby 97)
(define sql-get-info-maximumcolumnsingroupby 97)
(define sql-get-info-maxcolumnsinindex 98)
(define sql-get-info-maximumcolumnsinindex 98)
(define sql-get-info-maxcolumnsinorderby 99)
(define sql-get-info-maximumcolumnsinorderby 99)
(define sql-get-info-maxcolumnsinselect 100)
(define sql-get-info-maximumcolumnsinselect 100)
(define sql-get-info-maxcolumnsintable 101)
(define sql-get-info-maxindexsize 102)
(define sql-get-info-maximumindexsize 102)
(define sql-get-info-maxrowsize 104)
(define sql-get-info-maximumrowsize 104)
(define sql-get-info-maxstatementlen 105)
(define sql-get-info-maximumstatemenlen 105)
(define sql-get-info-maxtablesinselect 106)
(define sql-get-info-maximumtablesinselect 106)
(define sql-get-info-maxusernamelen 107)
(define sql-get-info-maximumusernamelen 107)
(define sql-get-info-ojcapabilities 115)
(define sql-get-info-outerjoincapabilities 115)
;;; 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)
(define-record-type odbc-environment :odbc-environment
(really-make-odbc-environment handle)
odbc-environment?
(handle odbc-environment-handle set-odbc-environment-handle!))
(define-record-type odbc-connection :odbc-connection
(really-make-odbc-connection handle)
odbc-connection?
(handle odbc-connection-handle set-odbc-connection-handle!))
(define-record-type odbc-statement :odbc-statement
(really-make-odbc-statment sql-query handle)
odbc-statement?
(sql-query odbc-statement-sql-query)
(handle odbc-statement-handle odbc-statement-handle!))
(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 make-odbc-environment
(lambda ()
(really-make-odbc-environment (odbc-alloc-environment-handle))))
(define make-odbc-connection
(lambda (odbc-environment datasource-name user password)
(let ((conn-handle (odbc-alloc-connection-handle
(odbc-environment-handle odbc-environment))))
(odbc-sql-connect conn-handle datasource-name user password)
(really-make-odbc-connection conn-handle))))
(define odbc-disconnect
(lambda (odbc-connection)
(odbc-sql-disconnect (odbc-connection-handle odbc-connection))))
(define make-odbc-statement
(lambda (odbc-connection sql-text)
(let* ((conn-handle (odbc-connection-handle odbc-connection))
(stmt-handle (odbc-alloc-statement-handle conn-handle)))
(odbc-sql-prepare stmt-handle)
(really-make-odbc-statment sql-text stmt-handle))))
(define odbc-get-datasources
(lambda (odbc-environment)
(let ((env-handle (odbc-environment-handle odbc-environment)))
(odbc-sql-data-sources env-handle))))
(define odbc-get-drivers
(lambda (odbc-environment)
#t))
(define odbc-get-environment-info
(lambda (odbc-environment key)
#t))
(define odbc-get-type-info
(lambda (odbc-statement type)
#t))
(define odbc-connection-attribute
(lambda (odbc-connection key)
#t))
(define set-odbc-connection-attribute!
(lambda (odbc-connection key value)
#t))
(define odbc-environment-attribute
(lambda (odbc-environment key)
#t))
(define set-odbc-environment-attribute!
(lambda (odbc-environment key value)
#t))
(define odbc-statement-attribute
(lambda (odbc-statement key)
#t))
(define set-odbc-statement-attribute!
(lambda (odbc-statement key value)
#t))
(define odbc-sql-execute-direct
(lambda (odbc-connection sql-query)
(let* ((conn-handle (odbc-connection-handle odbc-connection))
(stmt-handle (odbc-alloc-statement-handle conn-handle)))
(odbc-sql-execute-direct stmt-handle sql-query))))
(define odbc-sql-execute
(lambda (odbc-statement)
(let ((stmt-handle (odbc-statement-handle odbc-statement)))
(odbc-sql-execute odbc-statement))))
(define odbc-count-result-cols
(lambda (odbc-statement)
(let ((stmt-handle (odbc-statement-handle odbc-statement)))
(odbc-sql-num-result-cols stmt-handle))))
(define odbc-describe-column
(lambda (odbc-statement column-number)
(let ((stmt-handle (odbc-statement-handle odbc-statement)))
(odbc-sql-describe-col stmt-handle column-number))))
(define odbc-fetch-row
(lambda (odbc-statement)
(let* ((stmt-handle (odbc-statement-handle odbc-statement))
(retval (odbc-sql-fetch stmt-handle)))
(if (equal? retval sql-no-data)
'()
(let loop ((row '())
(col (odbc-sql-num-result-cols odbc-statement)))
(if (> col 1)
(let* ((col-info
(odbc-describe-column odbc-statement col))
(data
(odbc-sql-get-data stmt-handle col
(odbc-column-type col-info))))
(loop (cons data row) (- col 1)))
row))))))
;;;; just for testing purposes, will disappear soon
;(define open-db
; (lambda (server user auth)
; (let* ((env-handle (odbc-alloc-environment-handle))
; (conn-handle (odbc-alloc-connection-handle env-handle)))
; (odbc-sql-connect conn-handle server user auth))))
;(define list-datasources
; (lambda ()
; (let ((env-handle (odbc-alloc-environment-handle)))
; (odbc-sql-data-sources env-handle sql-datasources-fetch-first))))
;(define list-drivers
; (lambda ()
; (let ((env-handle (odbc-alloc-environment-handle)))
; (odbc-sql-drivers env-handle))))
;(define free-handle
; (lambda (handle handle-type)
; (odbc-sql-free-handle handle-type handle)))
;(define free-environment-handle
; (lambda (handle)
; (free-handle handle handle-type-env)))
;(define free-connection-handle
; (lambda (handle)
; (free-handle handle handle-type-dbc)))
;(define free-statement-handle
; (lambda (handle)
; (free-handle handle handle-type-stmt)))
;(define free-description-handle
; (lambda (handle)
; (free-handle handle handle-type-desc)))
;;; PART 1
(import-lambda-definition odbc-alloc-environment-handle
()
"odbc_alloc_environment_handle")
(import-lambda-definition odbc-alloc-connection-handle
(env-handle)
"odbc_alloc_connection_handle")
(import-lambda-definition odbc-alloc-statement-handle
(db-handle)
"odbc_alloc_statement_handle")
(import-lambda-definition odbc-sql-connect
(conn-handle server-name user-name auth)
"odbc_sql_connect")
;;; PART 2
(import-lambda-definition odbc-sql-data-sources
(env-handle direction)
"odbc_sql_data_sources")
(import-lambda-definition odbc-sql-drivers
(env-handle)
"odbc_sql_drivers")
(import-lambda-definition odbc-sql-get-info-int
(conn-handle info-key)
"odbc_sql_get_info_int")
(import-lambda-definition odbc-sql-get-info-string
(conn-handle info-key)
"odbc_sql_get_info_string")
(import-lambda-definition odbc-sql-get-func-exists
(conn-handle fun-id)
"odbc_sql_get_func_exists")
(import-lambda-definition odbc-sql-get-type-info
(stmt-handle data-type)
"odbc_sql_get_type_info")
;;; PART 3
(import-lambda-definition odbc-sql-set-connect-attr-int
(conn-handle attribute value)
"odbc_sql_set_connect_attr_int")
(import-lambda-definition odbc-sql-set-connect-attr-string
(conn-handle attribute value)
"odbc_sql_set_connect_attr_string")
(import-lambda-definition odbc-sql-get-connect-attr-string
(conn-handle attribute)
"odbc_sql_get_connect_attr_string")
(import-lambda-definition odbc-sql-get-connect-attr-int
(conn-handle attribute)
"odbc_sql_get_connect_attr_int")
(import-lambda-definition odbc-sql-set-env-attr-int
(env-handle attribute value)
"odbc_sql_set_env_attr_int")
(import-lambda-definition odbc-sql-get-env-attr-int
(env-handle attribute value)
"odbc_sql_get_env_attr_int")
(import-lambda-definition odbc-sql-set-stmt-attr-int
(stmt-handle attribute value)
"odbc_sql_set_stmt_attr_int")
(import-lambda-definition odbc-sql-set-stmt-attr-string
(stmt-handle attribute value)
"odbc_sql_set_stmt_attr_string")
(import-lambda-definition odbc-sql-get-stmt-attr-int
(stmt-handle attribute)
"odbc_sql_get_stmt_attr_int")
(import-lambda-definition odbc-sql-get-stmt-attr-string
(stmt-handle attribute)
"odbc_sql_get_stmt_attr_string")
;;; PART 4
;;; PART 5
(import-lambda-definition odbc-sql-prepare
(stmt-handle stmt-txt)
"odbc_sql_prepare")
(import-lambda-definition odbc-sql-bind-parameter-exec-out
(stmt-handle param-vals)
"odbc_sql_bind_parameter_exec_out")
;;; PART 6
(import-lambda-definition odbc-sql-execute
(stmt-handle)
"odbc_sql_execute")
(import-lambda-definition odbc-sql-execute-direct
(stmt-handle stmt-txt)
"odbc_sql_execute_direct")
;;; PART 7
(import-lambda-definition odbc-sql-get-data
(stmt-handle column-number target-type)
"odbc_sql_get_data")
(import-lambda-definition odbc-sql-fetch
(stmt-handle)
"odbc_sql_fetch")
;;; PART 8
;;; PART 9
(import-lambda-definition odbc-sql-free-statement
(stmt-handle option)
"odbc_sql_free_statement")
(import-lambda-definition odbc-sql-close-cursor
(stmt-handle)
"odbc_sql_close_cursor")
(import-lambda-definition odbc-sql-cancel
(stmt-handle)
"odbc_sql_cancel")
(import-lambda-definition odbc-sql-num-result-cols
(stmt-handle)
"odbc_sql_num_result_cols")
(import-lambda-definition odbc-sql-describe-col
(stmt-handle column-number)
"odbc_sql_describe_col")
;;; PART 10
(import-lambda-definition odbc-sql-disconnect
(conn-handle)
"odbc_sql_disconnect")
(import-lambda-definition odbc-sql-free-handle
(handle-type handle)
"odbc_sql_free_handle")