- record-types for sql-data, sql-time and sql-numeric
- tons of function ids for usage with SQLGetFunctions (sql-api-*) - some key values for SQLGetInfo (sql-get-info-*). Need to be sorted (renamed?) by type of return value. - minor code cleanups
This commit is contained in:
eknauel
parent
992bc80409
commit
f456608175
|
|
@ -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)
|
||||
|
|
@ -258,6 +492,14 @@
|
|||
(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
|
||||
|
|
@ -267,3 +509,4 @@
|
|||
(import-lambda-definition odbc-sql-free-handle
|
||||
(handle-type handle)
|
||||
"odbc_sql_free_handle")
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue