scsh-0.6/scsh/odbc/odbc.scm

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