diff --git a/scsh/odbc/odbc.scm b/scsh/odbc/odbc.scm index 9939fb8..268b7b2 100644 --- a/scsh/odbc/odbc.scm +++ b/scsh/odbc/odbc.scm @@ -1,45 +1,3 @@ - -;;; record types - -(define-record-type sql-date :sql-date - (make-sql-date year month day) - sql-date? - (year sql-date-year sql-date-year!) - (month sql-date-month sql-date-month!) - (day sql-date-day sql-date-day!)) - -(define-exported-binding "sql-date-record-type" :sql-date) - -(define-record-type sql-time :sql-time - (make-sql-time hour minute second) - sql-time? - (hour sql-time-hour sql-time-hour!) - (minute sql-time-minute sql-time-minute!) - (second sql-time-second sql-time-second!)) - -(define-exported-binding "sql-time-record-type" :sql-time) - -(define-record-type sql-timestamp :sql-timestamp - (make-sql-timestamp year month day hour minute second fraction) - sql-timestamp? - (year sql-timestamp-year sql-timestamp-year!) - (month sql-timestamp-month sql-timestamp-month!) - (day sql-timestamp-day sql-timestamp-day!) - (hour sql-timestamp-hour sql-timestamp-hour!) - (minute sql-timestamp-minute sql-timestamp-minute!) - (second sql-timestamp-second sql-timestamp-second!) - (fraction sql-timestamp-fraction sql-timestamp-fraction!)) - -(define-exported-binding "sql-timestamp-record-type" :sql-timestamp) - -(define-record-type sql-numeric :sql-numeric - (make-sql-numeric precision scale sign value) - sql-numeric? - (precision sql-precision sql-precision!) - (scale sql-scale sql-scale!) - (sign sql-sign sql-sign!) - (value sql-value sql-value!)) - ;;; handle type identifiers from sql.h (define handle-type-env 1) (define handle-type-dbc 2) @@ -57,7 +15,6 @@ (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) @@ -72,7 +29,6 @@ (define sql-type-c-bit -7) ;;; ODBC type identifier - (define sql-type-unknown 0) (define sql-type-char 1) (define sql-type-numeric 2) @@ -88,6 +44,284 @@ (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) @@ -128,142 +362,151 @@ ;;; PART 1 (import-lambda-definition odbc-alloc-environment-handle - () - "odbc_alloc_environment_handle") + () + "odbc_alloc_environment_handle") (import-lambda-definition odbc-alloc-connection-handle - (env-handle) - "odbc_alloc_connection_handle") + (env-handle) + "odbc_alloc_connection_handle") (import-lambda-definition odbc-alloc-statement-handle - (db-handle) - "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") + (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") + (env-handle direction) + "odbc_sql_data_sources") (import-lambda-definition odbc-sql-drivers - (env-handle) - "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") + (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") + (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") + (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") + (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") + (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") + (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") + (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") + (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") + (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") + (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") + (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") + (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") + (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") + (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") + (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") + (stmt-handle param-vals) + "odbc_sql_bind_parameter_exec_out") ;;; PART 6 (import-lambda-definition odbc-sql-execute - (stmt-handle) - "odbc_sql_execute") + (stmt-handle) + "odbc_sql_execute") (import-lambda-definition odbc-sql-execute-direct - (stmt-handle stmt-txt) - "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") + (stmt-handle column-number target-type) + "odbc_sql_get_data") (import-lambda-definition odbc-sql-fetch - (stmt-handle) - "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") + (stmt-handle option) + "odbc_sql_free_statement") (import-lambda-definition odbc-sql-close-cursor - (stmt-handle) - "odbc_sql_close_cursor") + (stmt-handle) + "odbc_sql_close_cursor") (import-lambda-definition odbc-sql-cancel - (stmt-handle) - "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") + (conn-handle) + "odbc_sql_disconnect") (import-lambda-definition odbc-sql-free-handle - (handle-type handle) - "odbc_sql_free_handle") + (handle-type handle) + "odbc_sql_free_handle") +