Changeset combined,2.1.1
- Timestamp:
- 11/28/2007 03:49:48 AM (19 years ago)
- branch-nick:
- 64-bit
- revision id:
- dsowen@tux-20071128034948-of18hhgvistm196l
- Location:
- combined/src/odbc
- Files:
-
- 4 edited
-
cffi-support.lisp (modified) (1 diff)
-
odbc-ff-interface.lisp (modified) (5 diffs)
-
odbc-functions.lisp (modified) (16 diffs)
-
parameter.lisp (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
combined/src/odbc/cffi-support.lisp
r1 r2.1.1 8 8 9 9 (defun get-string-nts (ptr) 10 (cffi:foreign-string-to-lisp ptr MOST-POSITIVE-FIXNUM 10 (cffi:foreign-string-to-lisp ptr MOST-POSITIVE-FIXNUM t)) 11 11 12 12 (defun put-string (ptr vector) -
combined/src/odbc/odbc-ff-interface.lisp
r1 r2.1.1 31 31 32 32 33 (defcfun "SQLAllocEnv" retcode (penv *sql-handle)) 34 35 (defcfun "SQLAllocConnect" retcode 36 (henv sql-handle) ; HENV henv 37 (*phdbc *sql-handle)) ; HDBC FAR *phdbc 38 39 (defcfun "SQLConnect" retcode 40 (hdbc sql-handle) ; HDBC hdbc 41 (*szDSN string-ptr) ; UCHAR FAR *szDSN 42 (cbDSN :short) ; SWORD cbDSN 43 (*szUID string-ptr) ; UCHAR FAR *szUID 44 (cbUID :short) ; SWORD cbUID 45 (*szAuthStr string-ptr) ; UCHAR FAR *szAuthStr 46 (cbAuthStr :short) ; SWORD cbAuthStr 47 ) 33 ;;;; dso- 34 35 (defctype sql-small-int :int16) 36 (defctype sql-u-small-int :uint16) 37 (defctype sql-integer :int32) 38 (defctype sql-u-integer :uint32) 39 (defctype sql-pointer :pointer) 40 (defctype sql-len sql-integer) 41 (defctype sql-u-len sql-u-integer) 42 (defctype sql-return sql-small-int) 43 44 (defctype *sql-small-int :pointer) 45 (defctype *sql-integer :pointer) 46 (defctype *sql-len :pointer) 47 (defctype *sql-u-len :pointer) 48 49 (defctype sql-handle :pointer) 50 (defctype sql-h-env sql-handle) 51 (defctype sql-h-dbc sql-handle) 52 (defctype sql-h-stmt sql-handle) 53 (defctype sql-h-wnd :pointer) 54 55 (defctype *sql-h-env :pointer) 56 (defctype *sql-h-dbc :pointer) 57 (defctype *sql-h-stmt :pointer) 58 59 (defmacro defsqlfun (name (&rest args)) 60 `(defcfun ,name sql-return ,@args)) 61 62 ;;;; -dso 63 64 65 66 (defsqlfun "SQLAllocEnv" 67 ((penv *sql-h-env))) 68 69 (defsqlfun "SQLAllocConnect" 70 ((henv sql-h-env) ; HENV henv 71 (*phdbc *sql-h-dbc))) ; HDBC FAR *phdbc 72 73 (defsqlfun "SQLDriverConnect" 74 ((hdbc sql-h-dbc) ; HDBC hdbc 75 (hwnd sql-h-wnd) ; SQLHWND hwnd 76 ;(*szConnStrIn string-ptr) ; UCHAR FAR *szConnStrIn 77 (*szConnStrIn string-ptr) ; UCHAR FAR *szConnStrIn 78 (cbConnStrIn sql-small-int) ; SWORD cbConnStrIn 79 ;(*szConnStrOut string-ptr) ; UCHAR FAR *szConnStrOut 80 (*szConnStrOut string-ptr) ; UCHAR FAR *szConnStrOut 81 (cbConnStrOutMax sql-small-int) ; SWORD cbConnStrOutMaxw 82 (*pcbConnStrOut *sql-small-int) ; SWORD FAR *pcbConnStrOut 83 (fDriverCompletion :unsigned-short))) ; UWORD fDriverCompletion 84 85 (defsqlfun "SQLDisconnect" 86 ((hdbc sql-h-dbc))) ; HDBC hdbc 87 88 (defsqlfun "SQLAllocStmt" 89 ((hdbc sql-h-dbc) ; HDBC hdbc 90 (*phstmt *sql-h-stmt))) ; HSTMT FAR *phstmt 91 92 93 94 (defsqlfun "SQLGetInfo" 95 ((hdbc sql-h-dbc) ; HDBC hdbc 96 (fInfoType sql-u-small-int) ; UWORD fInfoType 97 (rgbInfoValue sql-pointer) ; PTR rgbInfoValue 98 (cbInfoValueMax sql-small-int) ; SWORD cbInfoValueMax 99 (*pcbInfoValue *sql-small-int))) ; SWORD FAR *pcbInfoValue 100 101 102 (defsqlfun ("SQLGetInfo" SQLGetInfo-Str) 103 ((hdbc sql-h-dbc) ; HDBC hdbc 104 (fInfoType sql-u-small-int) ; UWORD fInfoType 105 (rgbInfoValue string-ptr) ; PTR rgbInfoValue 106 (cbInfoValueMax sql-small-int) ; SWORD cbInfoValueMax 107 (*pcbInfoValue *sql-small-int))) ; SWORD FAR *pcbInfoValue 108 109 110 (defsqlfun "SQLPrepare" 111 ((hstmt sql-h-stmt) ; HSTMT hstmt 112 (*szSqlStr string-ptr) ; UCHAR FAR *szSqlStr 113 (cbSqlStr sql-integer))) ; SDWORD cbSqlStr 114 115 116 117 (defsqlfun "SQLExecute" 118 ((hstmt sql-h-stmt))) ; HSTMT hstmt 119 120 121 (defsqlfun "SQLExecDirect" 122 ((hstmt sql-h-stmt) ; HSTMT hstmt 123 (*szSqlStr string-ptr) ; UCHAR FAR *szSqlStr 124 (cbSqlStr sql-integer))) ; SDWORD cbSqlStr 125 126 127 128 (defsqlfun "SQLFreeStmt" 129 ((hstmt sql-h-stmt) ; HSTMT hstmt 130 (fOption sql-u-small-int))) ; UWORD fOption 131 132 133 134 (defsqlfun "SQLError" 135 ((henv sql-h-env) ; HENV henv 136 (hdbc sql-h-dbc) ; HDBC hdbc 137 (hstmt sql-h-stmt) ; HSTMT hstmt 138 ; (*szSqlState string-ptr) ; UCHAR FAR *szSqlState 139 (*szSqlState string-ptr) ; UCHAR FAR *szSqlState 140 (*pfNativeError *sql-integer) ; SDWORD FAR *pfNativeError 141 ; (*szErrorMsg string-ptr) ; UCHAR FAR *szErrorMsg 142 (*szErrorMsg string-ptr) ; UCHAR FAR *szErrorMsg 143 (cbErrorMsgMax sql-small-int) ; SWORD cbErrorMsgMax 144 (*pcbErrorMsg *sql-small-int))) ; SWORD FAR *pcbErrorMsg 145 146 147 148 (defsqlfun "SQLNumResultCols" 149 ((hstmt sql-h-stmt) ; HSTMT hstmt 150 (*pccol *sql-small-int))) ; SWORD FAR *pccol 151 152 153 (defsqlfun "SQLRowCount" 154 ((hstmt sql-h-stmt) ; HSTMT hstmt 155 (*pcrow *sql-len))) ; SDWORD FAR *pcrow 156 157 158 (defsqlfun "SQLDescribeCol" 159 ((hstmt sql-h-stmt) ; HSTMT hstmt 160 (icol sql-u-small-int) ; UWORD icol 161 (*szColName string-ptr) ; UCHAR FAR *szColName 162 (cbColNameMax sql-small-int) ; SWORD cbColNameMax 163 (*pcbColName *sql-small-int) ; SWORD FAR *pcbColName 164 (*pfSqlType *sql-small-int) ; SWORD FAR *pfSqlType 165 (*pcbColDef *sql-u-len) ; UDWORD FAR *pcbColDef 166 (*pibScale *sql-small-int) ; SWORD FAR *pibScale 167 (*pfNullable *sql-small-int))) ; SWORD FAR *pfNullable 168 169 170 (defsqlfun "SQLBindCol" 171 ((hstmt sql-h-stmt) ; HSTMT hstmt 172 (icol sql-u-small-int) ; UWORD icol 173 (fCType sql-small-int) ; SWORD fCType 174 (rgbValue sql-pointer) ; PTR rgbValue 175 (cbValueMax sql-len) ; SDWORD cbValueMax 176 (*pcbValue *sql-len))) ; SDWORD FAR *pcbValue 177 48 178 49 (defcfun "SQLDriverConnect" retcode 50 (hdbc sql-handle) ; HDBC hdbc 51 (hwnd sql-handle) ; SQLHWND hwnd 52 ;(*szConnStrIn string-ptr) ; UCHAR FAR *szConnStrIn 53 (*szConnStrIn string-ptr) ; UCHAR FAR *szConnStrIn 54 (cbConnStrIn :short) ; SWORD cbConnStrIn 55 ;(*szConnStrOut string-ptr) ; UCHAR FAR *szConnStrOut 56 (*szConnStrOut string-ptr) ; UCHAR FAR *szConnStrOut 57 (cbConnStrOutMax :short) ; SWORD cbConnStrOutMaxw 58 (*pcbConnStrOut *short) ; SWORD FAR *pcbConnStrOut 59 (fDriverCompletion :unsigned-short) ; UWORD fDriverCompletion 60 ) 61 62 (defcfun "SQLDisconnect" retcode 63 (hdbc sql-handle)) ; HDBC hdbc 64 65 (defcfun "SQLAllocStmt" retcode 66 (hdbc sql-handle) ; HDBC hdbc 67 (*phstmt *sql-handle)) ; HSTMT FAR *phstmt 68 69 70 71 (defcfun "SQLGetInfo" retcode 72 (hdbc sql-handle) ; HDBC hdbc 73 (fInfoType :short) ; UWORD fInfoType 74 (rgbInfoValue :pointer) ; PTR rgbInfoValue 75 (cbInfoValueMax :short) ; SWORD cbInfoValueMax 76 (*pcbInfoValue :pointer) ; SWORD FAR *pcbInfoValue 77 ) 78 79 (defcfun ("SQLGetInfo" SQLGetInfo-Str) retcode 80 (hdbc sql-handle) ; HDBC hdbc 81 (fInfoType :short) ; UWORD fInfoType 82 (rgbInfoValue string-ptr) ; PTR rgbInfoValue 83 (cbInfoValueMax :short) ; SWORD cbInfoValueMax 84 (*pcbInfoValue :pointer) ; SWORD FAR *pcbInfoValue 85 ) 86 87 88 (defcfun "SQLPrepare" retcode 89 (hstmt sql-handle) ; HSTMT hstmt 90 (*szSqlStr string-ptr) ; UCHAR FAR *szSqlStr 91 (cbSqlStr :long) ; SDWORD cbSqlStr 92 ) 93 94 95 (defcfun "SQLExecute" retcode 96 (hstmt sql-handle) ; HSTMT hstmt 97 ) 98 99 100 (defcfun "SQLExecDirect" retcode 101 (hstmt sql-handle) ; HSTMT hstmt 102 (*szSqlStr string-ptr) ; UCHAR FAR *szSqlStr 103 (cbSqlStr :long) ; SDWORD cbSqlStr 104 ) 105 106 107 (defcfun "SQLFreeStmt" retcode 108 (hstmt sql-handle) ; HSTMT hstmt 109 (fOption :short)) ; UWORD fOption 110 111 112 (defcfun "SQLCancel" retcode 113 (hstmt sql-handle) ; HSTMT hstmt 114 ) 115 116 117 (defcfun "SQLError" retcode 118 (henv sql-handle) ; HENV henv 119 (hdbc sql-handle) ; HDBC hdbc 120 (hstmt sql-handle) ; HSTMT hstmt 121 ; (*szSqlState string-ptr) ; UCHAR FAR *szSqlState 122 (*szSqlState string-ptr) ; UCHAR FAR *szSqlState 123 (*pfNativeError *SDWORD) ; SDWORD FAR *pfNativeError 124 ; (*szErrorMsg string-ptr) ; UCHAR FAR *szErrorMsg 125 (*szErrorMsg string-ptr) ; UCHAR FAR *szErrorMsg 126 (cbErrorMsgMax :short) ; SWORD cbErrorMsgMax 127 (*pcbErrorMsg *short)) ; SWORD FAR *pcbErrorMsg 128 129 130 131 (defcfun "SQLNumResultCols" retcode 132 (hstmt sql-handle) ; HSTMT hstmt 133 (*pccol :pointer) ; SWORD FAR *pccol 134 ) 135 136 137 (defcfun "SQLRowCount" retcode 138 (hstmt sql-handle) ; HSTMT hstmt 139 (*pcrow *sdword) ; SDWORD FAR *pcrow 140 ) 141 142 143 (defcfun "SQLDescribeCol" retcode 144 (hstmt sql-handle) ; HSTMT hstmt 145 (icol :short) ; UWORD icol 146 (*szColName string-ptr) ; UCHAR FAR *szColName 147 (cbColNameMax :short) ; SWORD cbColNameMax 148 (*pcbColName *short) ; SWORD FAR *pcbColName 149 (*pfSqlType *short) ; SWORD FAR *pfSqlType 150 (*pcbColDef *ulong) ; UDWORD FAR *pcbColDef 151 (*pibScale *short) ; SWORD FAR *pibScale 152 (*pfNullable *short) ; SWORD FAR *pfNullable 153 ) 154 155 156 (defcfun "SQLColAttributes" retcode 157 (hstmt sql-handle) ; HSTMT hstmt 158 (icol :short) ; UWORD icol 159 (fDescType :short) ; UWORD fDescType 160 (rgbDesc :pointer) ; PTR rgbDesc 161 (cbDescMax :short) ; SWORD cbDescMax 162 (*pcbDesc *sword) ; SWORD FAR *pcbDesc 163 (*pfDesc *sdword) ; SDWORD FAR *pfDesc 164 ) 165 166 167 (defcfun "SQLColumns" retcode 168 (hstmt sql-handle) ; HSTMT hstmt 169 (*szTableQualifier string-ptr) ; UCHAR FAR *szTableQualifier 170 (cbTableQualifier :short) ; SWORD cbTableQualifier 171 (*szTableOwner string-ptr) ; UCHAR FAR *szTableOwner 172 (cbTableOwner :short) ; SWORD cbTableOwner 173 (*szTableName string-ptr) ; UCHAR FAR *szTableName 174 (cbTableName :short) ; SWORD cbTableName 175 (*szColumnName string-ptr) ; UCHAR FAR *szColumnName 176 (cbColumnName :short) ; SWORD cbColumnName 177 ) 178 179 180 (defcfun "SQLBindCol" retcode 181 (hstmt sql-handle) ; HSTMT hstmt 182 (icol :short) ; UWORD icol 183 (fCType :short) ; SWORD fCType 184 (rgbValue :pointer) ; PTR rgbValue 185 (cbValueMax :long) ; SDWORD cbValueMax 186 (*pcbValue *sdword) ; SDWORD FAR *pcbValue 187 ) 188 189 190 (defcfun "SQLFetch" retcode 191 (hstmt sql-handle) ; HSTMT hstmt 192 ) 193 194 195 (defcfun "SQLTransact" retcode 196 (henv sql-handle) ; HENV henv 197 (hdbc sql-handle) ; HDBC hdbc 198 (fType :short) ; UWORD fType ($SQL_COMMIT or $SQL_ROLLBACK) 199 ) 200 201 202 ;; ODBC 2.0 203 (defcfun "SQLDescribeParam" retcode 204 (hstmt sql-handle) ; HSTMT hstmt 205 (ipar :short) ; UWORD ipar 206 (*pfSqlType *sword) ; SWORD FAR *pfSqlType 207 (*pcbColDef *ulong) ; UDWORD FAR *pcbColDef 208 (*pibScale *sword) ; SWORD FAR *pibScale 209 (*pfNullable *sword) ; SWORD FAR *pfNullable 210 ) 211 212 213 ;; ODBC 2.0 214 (defcfun "SQLBindParameter" retcode 215 (hstmt sql-handle) ; HSTMT hstmt 216 (ipar :short) ; UWORD ipar 217 (fParamType :short) ; SWORD fParamType 218 (fCType :short) ; SWORD fCType 219 (fSqlType :short) ; SWORD fSqlType 220 (cbColDef :ulong) ; UDWORD cbColDef 221 (ibScale :short) ; SWORD ibScale 222 (rgbValue :pointer) ; PTR rgbValue 223 (cbValueMax :long) ; SDWORD cbValueMax 224 (*pcbValue *sdword) ; SDWORD FAR *pcbValue 225 ) 226 227 228 ;; level 1 229 (defcfun "SQLGetData" retcode 230 (hstmt sql-handle) ; HSTMT hstmt 231 (icol :short) ; UWORD icol 232 (fCType :short) ; SWORD fCType 233 (rgbValue :pointer) ; PTR rgbValue 234 (cbValueMax :long) ; SDWORD cbValueMax 235 (*pcbValue *sdword) ; SDWORD FAR *pcbValue 236 ) 237 238 239 (defcfun "SQLParamData" retcode 240 (hstmt sql-handle) ; HSTMT hstmt 241 (*prgbValue :pointer) ; PTR FAR *prgbValue 242 ) 243 244 245 (defcfun "SQLPutData" retcode 246 (hstmt sql-handle) ; HSTMT hstmt 247 (rgbValue :pointer) ; PTR rgbValue 248 (cbValue :long) ; SDWORD cbValue 249 ) 250 251 252 (defcfun "SQLGetConnectOption" retcode 253 (hdbc sql-handle) ; HDBC hdbc 254 (fOption :short) ; UWORD fOption 255 (pvParam :pointer) ; PTR pvParam 256 ) 257 258 259 (defcfun "SQLSetConnectOption" retcode 260 (hdbc sql-handle) ; HDBC hdbc 261 (fOption :short) ; UWORD fOption 262 (vParam :ulong) ; UDWORD vParam 263 ) 179 (defsqlfun "SQLFetch" 180 ((hstmt sql-h-stmt))) ; HSTMT hstmt 181 182 183 (defsqlfun "SQLTransact" 184 ((henv sql-h-env) ; HENV henv 185 (hdbc sql-h-dbc) ; HDBC hdbc 186 (fType sql-u-small-int))) ; UWORD fType ($SQL_COMMIT or $SQL_ROLLBACK) 187 188 189 ;; ODBC 2.0 190 (defsqlfun "SQLBindParameter" 191 ((hstmt sql-h-stmt) ; HSTMT hstmt 192 (ipar sql-u-small-int) ; UWORD ipar 193 (fParamType sql-small-int) ; SWORD fParamType 194 (fCType sql-small-int) ; SWORD fCType 195 (fSqlType sql-small-int) ; SWORD fSqlType 196 (cbColDef sql-u-len) ; UDWORD cbColDef 197 (ibScale sql-small-int) ; SWORD ibScale 198 (rgbValue sql-pointer) ; PTR rgbValue 199 (cbValueMax sql-len) ; SDWORD cbValueMax 200 (*pcbValue *sql-len))) ; SDWORD FAR *pcbValue 201 202 203 ;; level 1 204 (defsqlfun "SQLGetData" 205 ((hstmt sql-h-stmt) ; HSTMT hstmt 206 (icol sql-u-small-int) ; UWORD icol 207 (fCType sql-small-int) ; SWORD fCType 208 (rgbValue sql-pointer) ; PTR rgbValue 209 (cbValueMax sql-len) ; SDWORD cbValueMax 210 (*pcbValue *sql-len))) ; SDWORD FAR *pcbValue 211 212 213 (defsqlfun "SQLParamData" 214 ((hstmt sql-h-stmt) ; HSTMT hstmt 215 (*prgbValue sql-pointer))) ; PTR FAR *prgbValue 216 217 218 (defsqlfun "SQLPutData" 219 ((hstmt sql-h-stmt) ; HSTMT hstmt 220 (rgbValue sql-pointer) ; PTR rgbValue 221 (cbValue sql-len))) ; SDWORD cbValue 222 223 224 (defsqlfun "SQLSetConnectOption" 225 ((hdbc sql-h-dbc) ; HDBC hdbc 226 (fOption sql-u-small-int) ; UWORD fOption 227 (vParam sql-u-len))) ; UDWORD vParam 264 228 265 229 … … 277 241 ; driver-specific value, the value in ValuePtr may be a signed integer. 278 242 279 (defcfun ("SQLSetConnectAttr" SQLSetConnectAttr_long) retcode 280 (hdbc sql-handle) ; HDBC hdbc 281 (fOption :short) ; UWORD fOption 282 (pvParam :long) ; UDWORD vParam 283 (stringlength :long) 284 ) 285 286 287 (defcfun ("SQLSetConnectAttr" SQLSetConnectAttr_string) retcode 288 (hdbc sql-handle) ; HDBC hdbc 289 (fOption :short) ; UWORD fOption 290 (pvParam string-ptr) ; UDWORD vParam 291 (stringlength :long) 292 ) 293 294 295 296 (defcfun "SQLSetPos" retcode 297 (hstmt sql-handle) ; HSTMT hstmt 298 (irow :short) ; UWORD irow 299 (fOption :short) ; UWORD fOption 300 (fLock :short) ; UWORD fLock 301 ) 302 303 304 ; level 2 305 (defcfun "SQLExtendedFetch" retcode 306 (hstmt sql-handle) ; HSTMT hstmt 307 (fFetchType :short) ; UWORD fFetchType 308 (irow :long) ; SDWORD irow 309 (*pcrow :pointer) ; UDWORD FAR *pcrow 310 (*rgfRowStatus :pointer) ; UWORD FAR *rgfRowStatus 311 ) 312 313 (defcfun "SQLDataSources" retcode 314 (henv sql-handle) ; HENV henv 315 (fDirection :short) 316 (*szDSN string-ptr) ; UCHAR FAR *szDSN 317 (cbDSNMax :short) ; SWORD cbDSNMax 318 (*pcbDSN *sword) ; SWORD *pcbDSN 319 (*szDescription string-ptr) ; UCHAR *szDescription 320 (cbDescriptionMax :short) ; SWORD cbDescriptionMax 321 (*pcbDescription *sword) ; SWORD *pcbDescription 322 ) 323 324 325 (defcfun "SQLFreeEnv" retcode 326 (henv sql-handle) ; HSTMT hstmt 327 ) 328 329 330 (defcfun "SQLMoreResults" retcode 331 (hstmt sql-handle)) 243 (defsqlfun ("SQLSetConnectAttr" SQLSetConnectAttr_long) 244 ((hdbc sql-h-dbc) ; HDBC hdbc 245 ;; TODO: The new def of fOption doesn't seem compatible with the 246 ;; original, but matches my headers. 247 (fOption sql-integer) ; UWORD fOption 248 (pvParam sql-integer) ; UDWORD vParam 249 (stringlength sql-integer))) 250 251 252 (defsqlfun ("SQLSetConnectAttr" SQLSetConnectAttr_string) 253 ((hdbc sql-handle) ; HDBC hdbc 254 (fOption sql-integer) ; UWORD fOption 255 (pvParam string-ptr) ; UDWORD vParam 256 (stringlength sql-integer))) 257 258 259 ;; level 2 260 (defsqlfun "SQLMoreResults" 261 ((hstmt sql-h-stmt))) 332 262 333 263 334 264 ;;; foreign type definitions 335 265 336 337 (hour :short)338 (minute :short)339 (second :short))340 341 342 (year :short)343 (month :short)344 (day :short))345 346 347 (year :short)348 (month :short)349 (day :short)350 (hour :short)351 (minute :short)352 (second :short)353 (fraction :long))266 (defcstruct sql-c-time "" 267 (hour sql-u-small-int) 268 (minute sql-u-small-int) 269 (second sql-u-small-int)) 270 271 (defcstruct sql-c-date "" 272 (year sql-small-int) 273 (month sql-u-small-int) 274 (day sql-u-small-int)) 275 276 (defcstruct sql-c-timestamp "" 277 (year sql-small-int) 278 (month sql-u-small-int) 279 (day sql-u-small-int) 280 (hour sql-u-small-int) 281 (minute sql-u-small-int) 282 (second sql-u-small-int) 283 (fraction sql-u-integer)) 354 284 355 285 (defun %put-sql-c-date (adr %year %month %day) … … 358 288 (setf (foreign-slot-value adr 'sql-c-date 'day) %day)) 359 289 360 361 (defun %put-sql-c-timestamp (adr %year %month %day %hour %minute %second %fraction) 290 291 (defun %put-sql-c-timestamp (adr %year %month %day %hour %minute %second 292 %fraction) 362 293 (setf (foreign-slot-value adr 'sql-c-timestamp 'second) %second) 363 294 (setf (foreign-slot-value adr 'sql-c-timestamp 'minute) %minute) … … 366 297 (setf (foreign-slot-value adr 'sql-c-timestamp 'month) %month) 367 298 (setf (foreign-slot-value adr 'sql-c-timestamp 'year) %year) 368 (setf (foreign-slot-value adr 'sql-c-timestamp 'fraction) %fraction) 369 ) 299 (setf (foreign-slot-value adr 'sql-c-timestamp 'fraction) %fraction)) 370 300 371 301 (defun timestamp-to-universal-time (adr) 372 (with-foreign-slots 302 (with-foreign-slots 373 303 ((year month day hour minute second fraction) adr sql-c-timestamp) 374 304 (values … … 379 309 day 380 310 month 381 year 311 year) 382 312 fraction))) 383 313 384 314 385 315 (defun date-to-universal-time (adr) 386 (with-foreign-slots 316 (with-foreign-slots 387 317 ((year month day) adr sql-c-date) 388 318 (encode-universal-time 389 390 391 392 393 394 395 (defmacro %sql-len-data-at-exec (length) 319 0 0 0 320 day 321 month 322 year))) 323 324 325 (defmacro %sql-len-data-at-exec (length) 396 326 `(- $SQL_LEN_DATA_AT_EXEC_OFFSET ,length)) -
combined/src/odbc/odbc-functions.lisp
r1 r2.1.1 17 17 `(let (,@allocs) 18 18 (unwind-protect 19 (progn ,@body) 20 ,@(mapcar (lambda (alloc) (list 'cffi:foreign-free (first alloc))) allocs)))) 21 22 19 (progn ,@body) 20 ,@(mapcar (lambda (alloc) (list 'cffi:foreign-free (first alloc))) 21 allocs)))) 22 23 23 24 24 25 … … 44 45 ()) 45 46 47 ;;;; dso+ 46 48 (defun handle-error (henv hdbc hstmt) 47 (let 48 ((sql-state (alloc-chars 256)) 49 (error-message (alloc-chars #.$SQL_MAX_MESSAGE_LENGTH)) 50 (error-code (cffi:foreign-alloc :long)) 51 (msg-length (cffi:foreign-alloc :short))) 52 (SQLError henv 53 hdbc 54 hstmt sql-state 55 error-code error-message 56 $SQL_MAX_MESSAGE_LENGTH msg-length) 57 (values 58 (get-string-nts error-message) 59 (get-string-nts sql-state) 60 (cffi:mem-ref msg-length :short) 61 (cffi:mem-ref error-code :long)))) 49 (let 50 ((sql-state (alloc-chars 256)) ; TODO: How do we know this is 51 ; big enough? 52 (error-message (alloc-chars #.$SQL_MAX_MESSAGE_LENGTH)) 53 (error-code (cffi:foreign-alloc 'sql-integer)) 54 (msg-length (cffi:foreign-alloc 'sql-small-int))) 55 ;; TODO: Does this include null-terminator for error-message? 56 (SQLError henv 57 hdbc 58 hstmt sql-state 59 error-code error-message 60 $SQL_MAX_MESSAGE_LENGTH msg-length) 61 (values 62 (get-string-nts error-message) 63 (get-string-nts sql-state) 64 (cffi:mem-ref msg-length 'sql-small-int) 65 (cffi:mem-ref error-code 'sql-integer)))) 62 66 63 67 … … 66 70 ;; problem: calling SQLError clears the error state 67 71 ;#+ignore 72 ;;;; dso+ 68 73 (defun sql-state (henv hdbc hstmt) 69 (with-temporary-allocations 74 (with-temporary-allocations 70 75 ((sql-state (cffi:foreign-alloc :char :count 256)) 71 76 (error-message (cffi:foreign-alloc :char :count $SQL_MAX_MESSAGE_LENGTH)) 72 (error-code (cffi:foreign-alloc :long))73 (msg-length (cffi:foreign-alloc :short)))77 (error-code (cffi:foreign-alloc 'sql-integer)) 78 (msg-length (cffi:foreign-alloc 'sql-small-int))) 74 79 (SQLError henv hdbc hstmt sql-state error-code 75 80 error-message $SQL_MAX_MESSAGE_LENGTH msg-length) 76 (get-string sql-state 5) ;(%cstring-to-keyword sql-state)81 (get-string sql-state 5) ;(%cstring-to-keyword sql-state) 77 82 )) 78 83 … … 164 169 165 170 171 ;;;; dso+ 166 172 (defun %new-environment-handle () 167 (cffi:with-foreign-object (phenv 'sql-handle) 173 (declare (ftype sql-h-env)) 174 (cffi:with-foreign-object (phenv 'sql-h-env) 168 175 (with-error-handling 169 () 170 (SQLAllocEnv phenv) 171 (cffi:mem-ref phenv 'sql-handle) 172 ))) 173 174 (defun %sql-free-environment (henv) 175 (with-error-handling 176 (:henv henv) 177 (SQLFreeEnv henv))) 178 176 () 177 (SQLAllocEnv phenv) 178 (cffi:mem-ref phenv 'sql-h-env)))) 179 180 ;;;; dso+ 179 181 (defun %new-db-connection-handle (henv) 180 (cffi:with-foreign-object (phdbc 'sql-h andle)182 (cffi:with-foreign-object (phdbc 'sql-h-dbc) 181 183 (with-error-handling 182 184 (:henv henv) 183 (SQLAllocConnect henv phdbc) 184 (cffi:mem-ref phdbc 'sql-handle)))) 185 185 (SQLAllocConnect henv phdbc) 186 (cffi:mem-ref phdbc 'sql-h-dbc)))) 187 188 ;;;; dso+ 186 189 (defun %free-statement (hstmt option) 187 (with-error-handling 190 (with-error-handling 188 191 (:hstmt hstmt) 189 (SQLFreeStmt 190 hstmt 192 (SQLFreeStmt 193 hstmt 191 194 (ecase option 192 195 (:drop $SQL_DROP) … … 217 220 ;; functional interface 218 221 219 (defun %sql-connect (hdbc server uid pwd)220 (cffi:with-foreign-string (server-ptr server)221 (cffi:with-foreign-string (uid-ptr uid)222 (cffi:with-foreign-string (pwd-ptr pwd)223 (with-error-handling224 (:hdbc hdbc)225 (SQLConnect hdbc server-ptr $SQL_NTS uid-ptr226 $SQL_NTS pwd-ptr $SQL_NTS))))))227 228 222 ;; 223 ;;;; dso+ 229 224 (defun %sql-driver-connect (henv hdbc connection-string completion-option) 225 (declare (string connection-string)) 230 226 (let ((completion-option 231 227 (ecase completion-option … … 234 230 (:prompt $SQL_DRIVER_PROMPT) 235 231 (:noprompt $SQL_DRIVER_NOPROMPT)))) 236 (cffi:with-foreign-string (connection-str-ptr 232 (cffi:with-foreign-string (connection-str-ptr connection-string) 237 233 (with-temporary-allocations 238 234 ((complete-connection-str-ptr (alloc-chars 1024)) 239 (length-ptr (cffi:foreign-alloc :short)))240 (with-error-handling 235 (length-ptr (cffi:foreign-alloc 'sql-small-int))) 236 (with-error-handling 241 237 (:henv henv :hdbc hdbc) 242 243 (SQLDriverConnect hdbc 244 (cffi:null-pointer) ; no window 245 connection-str-ptr 246 (length connection-string) 247 ;$SQL_NTS 248 complete-connection-str-ptr 249 1024 250 length-ptr 251 completion-option)) 238 239 (SQLDriverConnect hdbc 240 (cffi:null-pointer) ; no window 241 connection-str-ptr ; TODO: How does 242 ; encoding affect the 243 ; length? 244 (length connection-string) ;$SQL_NTS 245 complete-connection-str-ptr 246 1024 ; TODO: Should this 1023, for 247 ; the terminating char? 248 length-ptr 249 completion-option)) 252 250 (get-string-nts complete-connection-str-ptr))))) 253 251 252 ;;;; dso+ 254 253 (defun %disconnect (hdbc) 255 (with-error-handling 256 (:hdbc hdbc) 257 (SQLDisconnect hdbc))) 258 254 (with-error-handling 255 (:hdbc hdbc) 256 (SQLDisconnect hdbc))) 257 258 ;;;; dso+ 259 259 (defun %commit (henv hdbc) 260 (with-error-handling 261 (:henv henv :hdbc hdbc) 262 (SQLTransact 263 henv hdbc $SQL_COMMIT))) 264 260 (with-error-handling 261 (:henv henv :hdbc hdbc) 262 (SQLTransact 263 henv hdbc $SQL_COMMIT))) 264 265 ;;;; dso+ 265 266 (defun %rollback (henv hdbc) 266 (with-error-handling 267 (:henv henv :hdbc hdbc)268 (SQLTransact269 henv hdbc $SQL_ROLLBACK)))267 (with-error-handling 268 (:henv henv :hdbc hdbc) 269 (SQLTransact 270 henv hdbc $SQL_ROLLBACK))) 270 271 271 272 ; col-nr is zero-based in Lisp 272 273 ; col-nr = :bookmark retrieves a bookmark. 274 ;;;; dso+ 273 275 (defun %bind-column (hstmt column-nr c-type data-ptr precision out-len-ptr) 274 (with-error-handling 275 (:hstmt hstmt) 276 (SQLBindCol hstmt 277 (if (eq column-nr :bookmark) 0 (1+ column-nr)) 278 c-type data-ptr precision out-len-ptr))) 276 (declare ((integer 0) column-nr)) 277 (with-error-handling 278 (:hstmt hstmt) 279 (SQLBindCol hstmt 280 (if (eq column-nr :bookmark) 0 (1+ column-nr)) 281 c-type data-ptr precision out-len-ptr))) 279 282 280 283 ; parameter-nr is zero-based in Lisp 284 ;;;; dso+ 281 285 (defun %sql-bind-parameter (hstmt parameter-nr parameter-type c-type 282 sql-type precision scale data-ptr 283 max-value out-len-ptr) 284 (with-error-handling 285 (:hstmt hstmt) 286 (SQLBindParameter hstmt (1+ parameter-nr) 287 parameter-type ;$SQL_PARAM_INPUT 288 c-type ;$SQL_C_CHAR 289 sql-type ;$SQL_VARCHAR 290 precision ;(1- (length str)) 291 scale ;0 292 data-ptr 293 max-value 294 out-len-ptr ;#.(cffi:null-pointer) 295 ))) 296 286 sql-type precision scale data-ptr 287 max-value out-len-ptr) 288 (declare ((integer 0) parameter-nr)) 289 (with-error-handling 290 (:hstmt hstmt) 291 (SQLBindParameter hstmt (1+ parameter-nr) 292 parameter-type ;$SQL_PARAM_INPUT 293 c-type ;$SQL_C_CHAR 294 sql-type ;$SQL_VARCHAR 295 precision ;(1- (length str)) 296 scale ;0 297 data-ptr 298 max-value 299 out-len-ptr ;#.(cffi:null-pointer) 300 ))) 301 302 ;;;; dso+ 297 303 (defun %sql-fetch (hstmt) 298 304 (with-error-handling … … 300 306 (SQLFetch hstmt))) 301 307 308 ;;;; dso+ 302 309 (defun %new-statement-handle (hdbc) 303 (with-temporary-allocations 304 ((hstmt-ptr (cffi:foreign-alloc 'sql-h andle)))305 (with-error-handling 310 (with-temporary-allocations 311 ((hstmt-ptr (cffi:foreign-alloc 'sql-h-stmt))) 312 (with-error-handling 306 313 (:hdbc hdbc) 307 (SQLAllocStmt hdbc hstmt-ptr) 308 (cffi:mem-ref hstmt-ptr 'sql-handle)))) 309 314 (SQLAllocStmt hdbc hstmt-ptr) 315 (cffi:mem-ref hstmt-ptr 'sql-h-stmt)))) 316 317 ;;;; dso+ 310 318 (defun %sql-get-info (hdbc info-type) 311 319 (ecase info-type … … 344 352 #.$SQL_TABLE_TERM 345 353 #.$SQL_USER_NAME) 346 (with-temporary-allocations 354 (with-temporary-allocations 347 355 ((info-ptr (alloc-chars 1024)) 348 (info-length-ptr (cffi:foreign-alloc :short)))349 (with-error-handling 350 (:hdbc hdbc)351 356 (info-length-ptr (cffi:foreign-alloc 'sql-small-int))) 357 (with-error-handling 358 (:hdbc hdbc) 359 #-pcl 352 360 (SQLGetInfo hdbc info-type info-ptr 1023 info-length-ptr) 353 361 #+pcl 354 362 (SQLGetInfo-Str hdbc info-type info-ptr 1023 info-length-ptr) 363 ;; TODO: I believe the following assumes that the buffer was 364 ;; big enough to include the null-terminator. 355 365 (get-string-nts info-ptr)))) 356 ;; those returning a word366 ;; those returning a 16-bit integer 357 367 ((#.$SQL_ACTIVE_CONNECTIONS 358 368 #.$SQL_ACTIVE_STATEMENTS … … 383 393 #.$SQL_TXN_CAPABLE) 384 394 (with-temporary-allocations 385 ((info-ptr (cffi::foreign-alloc :short)) 386 (info-length-ptr (cffi::foreign-alloc :short))) 387 (with-error-handling 388 (:hdbc hdbc) 389 (SQLGetInfo hdbc 390 info-type 391 info-ptr 392 255 393 info-length-ptr) 394 (cffi:mem-ref info-ptr :short))) 395 ) 396 ;; those returning a long bitmask 397 ((#.$SQL_ALTER_TABLE 395 ((info-ptr (cffi::foreign-alloc 'sql-small-int)) 396 (info-length-ptr (cffi::foreign-alloc 'sql-small-int))) 397 (with-error-handling 398 (:hdbc hdbc) 399 (SQLGetInfo hdbc 400 info-type 401 info-ptr 402 0 403 info-length-ptr) 404 (cffi:mem-ref info-ptr 'sql-small-int)))) 405 ;; those returning a 32-bit bitmask 406 ((#.$SQL_ALTER_TABLE 398 407 #.$SQL_BOOKMARK_PERSISTENCE 399 408 #.$SQL_CONVERT_BIGINT … … 440 449 #.$SQL_TXN_ISOLATION_OPTION 441 450 #.$SQL_UNION) 442 (with-temporary-allocations 443 ((info-ptr (cffi:foreign-alloc :unsigned-long)) 444 (info-length-ptr (cffi:foreign-alloc :short))) 445 (with-error-handling 446 (:hdbc hdbc) 447 (SQLGetInfo hdbc 448 info-type 449 info-ptr 450 255 451 info-length-ptr) 452 (cffi:mem-ref info-ptr :unsigned-long))) 453 ) 454 ;; those returning a long integer 451 (with-temporary-allocations 452 ((info-ptr (cffi:foreign-alloc :uint32)) ; TODO: It'd be nice 453 ; to have this as a 454 ; sql-* type. 455 (info-length-ptr (cffi:foreign-alloc 'sql-small-int))) 456 (with-error-handling 457 (:hdbc hdbc) 458 (SQLGetInfo hdbc 459 info-type 460 info-ptr 461 0 462 info-length-ptr) 463 (cffi:mem-ref info-ptr :uint32)))) 464 ;; those returning an integer 455 465 ((#.$SQL_DEFAULT_TXN_ISOLATION 456 466 #.$SQL_DRIVER_HDBC … … 462 472 #.$SQL_MAX_BINARY_LITERAL_LEN 463 473 #.$SQL_MAX_CHAR_LITERAL_LEN 464 #.$SQL_ACTIVE_ENVIRONMENTS 465 )466 (with-temporary-allocations467 ((info-ptr (cffi:foreign-alloc :long))468 (info-length-ptr (cffi:foreign-alloc :short)))469 (with-error-handling470 (:hdbc hdbc)471 ( SQLGetInfo hdbc info-type info-ptr 255 info-length-ptr)472 (cffi:mem-ref info-ptr :unsigned-long)))))) 473 474 #.$SQL_ACTIVE_ENVIRONMENTS) 475 (with-temporary-allocations 476 ((info-ptr (cffi:foreign-alloc 'sql-integer)) 477 (info-length-ptr (cffi:foreign-alloc 'sql-small-int))) 478 (with-error-handling 479 (:hdbc hdbc) 480 (SQLGetInfo hdbc info-type info-ptr 0 info-length-ptr) 481 (cffi:mem-ref info-ptr 'sql-integer)))))) 482 483 ;;;; dso+ 474 484 (defun %sql-exec-direct (sql hstmt henv hdbc) 485 (declare (string sql)) 475 486 (cffi:with-foreign-string (sql-ptr sql) 476 487 (with-error-handling 477 488 (:hstmt hstmt :henv henv :hdbc hdbc) 478 (SQLExecDirect hstmt sql-ptr $SQL_NTS)))) 479 480 (defun %sql-cancel (hstmt) 481 (with-error-handling 482 (:hstmt hstmt) 483 (SQLCancel hstmt))) 484 489 (SQLExecDirect hstmt sql-ptr $SQL_NTS)))) 490 491 ;;;; dso+ 485 492 (defun %sql-execute (hstmt) 486 493 (with-error-handling 487 (:hstmt hstmt) 488 (SQLExecute hstmt))) 489 494 (:hstmt hstmt) 495 (SQLExecute hstmt))) 496 497 ;;;; dso+ 490 498 (defun result-columns-count (hstmt) 491 499 (with-temporary-allocations 492 ((columns-nr-ptr (cffi:foreign-alloc :short)))500 ((columns-nr-ptr (cffi:foreign-alloc 'sql-small-int))) 493 501 (with-error-handling (:hstmt hstmt) 494 (SQLNumResultCols hstmt columns-nr-ptr) 495 (cffi:mem-ref columns-nr-ptr :short)))) 496 502 (SQLNumResultCols hstmt columns-nr-ptr) 503 (cffi:mem-ref columns-nr-ptr 'sql-small-int)))) 504 505 ;;;; dso+ 497 506 (defun result-rows-count (hstmt) 498 507 (with-temporary-allocations 499 ((row-count-ptr (cffi:foreign-alloc :long)))508 ((row-count-ptr (cffi:foreign-alloc 'sql-len))) 500 509 (with-error-handling (:hstmt hstmt) 501 502 (cffi:mem-ref row-count-ptr :long))))510 (SQLRowCount hstmt row-count-ptr) 511 (cffi:mem-ref row-count-ptr 'sql-len)))) 503 512 504 513 … … 507 516 508 517 ;; Column counting is 1-based 518 ;;;; dso+ 509 519 (defun %describe-column (hstmt column-nr) 510 (with-temporary-allocations ((column-name-ptr (alloc-chars 256)) 511 (column-name-length-ptr (cffi:foreign-alloc :short)) 512 (column-sql-type-ptr (cffi:foreign-alloc :short)) 513 (column-precision-ptr (cffi:foreign-alloc :unsigned-long)) 514 (column-scale-ptr (cffi:foreign-alloc :short)) 515 (column-nullable-p-ptr (cffi:foreign-alloc :short))) 520 (declare ((integer 1) column-nr)) 521 (with-temporary-allocations 522 ((column-name-ptr (alloc-chars 256)) 523 (column-name-length-ptr (cffi:foreign-alloc 'sql-small-int)) 524 (column-sql-type-ptr (cffi:foreign-alloc 'sql-small-int)) 525 (column-precision-ptr (cffi:foreign-alloc 'sql-u-len)) 526 (column-scale-ptr (cffi:foreign-alloc 'sql-small-int)) 527 (column-nullable-p-ptr (cffi:foreign-alloc 'sql-small-int))) 516 528 (with-error-handling (:hstmt hstmt) 517 (SQLDescribeCol hstmt column-nr column-name-ptr 256 518 column-name-length-ptr 519 column-sql-type-ptr 520 column-precision-ptr 521 column-scale-ptr 522 column-nullable-p-ptr) 529 (SQLDescribeCol hstmt column-nr column-name-ptr 256 530 ;; TODO: Does 256 leave room for terminating 531 ;; nulls? 532 column-name-length-ptr 533 column-sql-type-ptr 534 column-precision-ptr 535 column-scale-ptr 536 column-nullable-p-ptr) 523 537 (values 524 538 (get-string-nts column-name-ptr) 525 (cffi:mem-ref column-sql-type-ptr :short) 526 (cffi:mem-ref column-precision-ptr :unsigned-long) 527 (cffi:mem-ref column-scale-ptr :short) 528 (cffi:mem-ref column-nullable-p-ptr :short))))) 529 530 ;; parameter counting is 1-based 531 (defun %describe-parameter (hstmt parameter-nr) 532 (with-temporary-allocations ((column-sql-type-ptr (cffi:foreign-alloc :short)) 533 (column-precision-ptr (cffi:foreign-alloc :long)) 534 (column-scale-ptr (cffi:foreign-alloc :short)) 535 (column-nullable-p-ptr (cffi:foreign-alloc :short))) 536 (with-error-handling 537 (:hstmt hstmt) 538 (SQLDescribeParam hstmt parameter-nr 539 column-sql-type-ptr 540 column-precision-ptr 541 column-scale-ptr 542 column-nullable-p-ptr) 543 (values 544 (cffi:mem-ref column-sql-type-ptr :short) 545 (cffi:mem-ref column-precision-ptr :unsigned-long) 546 (cffi:mem-ref column-scale-ptr :short) 547 (cffi:mem-ref column-nullable-p-ptr :short))))) 548 549 (defun %column-attributes (hstmt column-nr descriptor-type) 550 (with-temporary-allocations 551 ((descriptor-info-ptr (alloc-chars 256)) 552 (descriptor-length-ptr (cffi:foreign-alloc :short)) 553 (numeric-descriptor-ptr (cffi:foreign-alloc :long))) 554 (with-error-handling 555 (:hstmt hstmt) 556 (SQLColAttributes hstmt column-nr descriptor-type descriptor-info-ptr 256 557 descriptor-length-ptr 558 numeric-descriptor-ptr) 559 (values 560 (get-string-nts descriptor-info-ptr) 561 (cffi:mem-ref numeric-descriptor-ptr :long))))) 539 (cffi:mem-ref column-sql-type-ptr 'sql-small-int) 540 (cffi:mem-ref column-precision-ptr 'sql-u-len) 541 (cffi:mem-ref column-scale-ptr 'sql-small-int) 542 (cffi:mem-ref column-nullable-p-ptr 'sql-small-int))))) 562 543 563 544 … … 590 571 (fetch-all-rows hstmt))) 591 572 592 (defun %sql-data-sources (henv &key (direction :first)) 593 (with-temporary-allocations 594 ((name-ptr (alloc-chars (1+ $SQL_MAX_DSN_LENGTH))) 595 (name-length-ptr (cffi:foreign-alloc :short)) 596 (description-ptr (alloc-chars 1024)) 597 (description-length-ptr (cffi:foreign-alloc :short))) 598 (let ((res (with-error-handling 599 (:henv henv) 600 (SQLDataSources henv 601 (ecase direction 602 (:first $SQL_FETCH_FIRST) 603 (:next $SQL_FETCH_NEXT)) 604 name-ptr 605 (1+ $SQL_MAX_DSN_LENGTH) 606 name-length-ptr 607 description-ptr 608 1024 609 description-length-ptr)))) 610 (unless (= res $SQL_NO_DATA_FOUND) 611 (values (get-string-nts name-ptr) 612 (get-string-nts description-ptr)))))) 613 614 573 574 ;;;; dso+ 615 575 (defun %sql-prepare (hstmt sql) 576 (declare (string sql)) 616 577 (cffi:with-foreign-string (sql-ptr sql) 617 578 (with-error-handling (:hstmt hstmt) 618 (SQLPrepare hstmt sql-ptr $SQL_NTS)))) 619 620 ;; depending on option, we return a long int or a string; string not implemented 621 (defun get-connection-option (hdbc option) 622 (with-temporary-allocations 623 ((param-ptr (cffi:foreign-alloc :long))) ;#+ignore #.(1+ $SQL_MAX_OPTION_STRING_LENGTH))) 624 (with-error-handling (:hdbc hdbc) 625 (SQLGetConnectOption hdbc option param-ptr) 626 (cffi:mem-ref param-ptr :long)))) 627 579 (SQLPrepare hstmt sql-ptr $SQL_NTS)))) 580 581 ;;;; dso+ 628 582 (defun set-connection-option (hdbc option param) 629 583 (with-error-handling (:hdbc hdbc) 630 (SQLSetConnectOption hdbc option param)))584 (SQLSetConnectOption hdbc option param))) 631 585 632 586 (defun disable-autocommit (hdbc) … … 641 595 ;;; added tracing support 642 596 597 ;;;; dso+ 643 598 (defun set-connection-attr-integer (hdbc option val) 644 599 (with-error-handling (:hdbc hdbc) 645 (SQLSetConnectAttr_long hdbc option val 0))) 646 600 (SQLSetConnectAttr_long hdbc option val 0))) 601 602 ;;;; dso+ 647 603 (defun set-connection-attr-string (hdbc option val) 648 (with-error-handling (:hdbc hdbc) 649 (cffi:with-foreign-string (ptr val) 650 (SQLSetConnectAttr_string hdbc option ptr (length val))))) 604 (with-error-handling (:hdbc hdbc) 605 (cffi:with-foreign-string (ptr val) 606 ;; TODO: Null-terminator with length? 607 (SQLSetConnectAttr_string hdbc option ptr (length val))))) 651 608 652 609 (defun %start-connection-trace (hdbc filename) … … 691 648 ;;; 692 649 693 694 (defun %sql-set-pos (hstmt row option lock)695 (with-error-handling696 (:hstmt hstmt)697 (SQLSetPos hstmt row option lock)))698 699 (defun %sql-extended-fetch (hstmt fetch-type row)700 (with-temporary-allocations701 ((row-count-ptr (cffi:foreign-alloc :unsigned-long))702 (row-status-ptr (cffi:foreign-alloc :short)))703 (with-error-handling (:hstmt hstmt)704 (SQLExtendedFetch hstmt fetch-type row row-count-ptr705 row-status-ptr)706 (values (cffi:mem-ref row-count-ptr :unsigned-long)707 (cffi:mem-ref row-status-ptr :short)))))708 709 650 ; column-nr is zero-based 651 ;;;; dso+ 710 652 (defun %sql-get-data (hstmt column-nr c-type data-ptr precision out-len-ptr) 711 (with-error-handling 712 (:hstmt hstmt :print-info nil) 713 (SQLGetData hstmt (if (eq column-nr :bookmark) 0 (1+ column-nr)) 714 c-type data-ptr precision out-len-ptr))) 715 653 (declare ((integer 0) column-nr)) 654 (with-error-handling 655 (:hstmt hstmt :print-info nil) 656 (SQLGetData hstmt (if (eq column-nr :bookmark) 0 (1+ column-nr)) 657 c-type data-ptr precision out-len-ptr))) 658 659 ;;;; dso+ 716 660 (defun %sql-get-data-raw (hstmt position c-type data-ptr buffer-length ind-ptr) 661 (declare ((integer 0) position)) 717 662 (SQLGetData hstmt (1+ position) 718 663 c-type data-ptr buffer-length ind-ptr)) 719 664 720 665 666 ;;;; dso+ 721 667 (defun %sql-param-data (hstmt param-ptr) 722 668 (with-error-handling (:hstmt hstmt :print-info t) ;; nil … … 724 670 725 671 672 ;;;; dso+ 726 673 (defun %sql-put-data (hstmt data-ptr size) 727 674 (with-error-handling 728 675 (:hstmt hstmt :print-info t) ;; nil 729 (SQLPutData hstmt data-ptr size))) 730 731 676 (SQLPutData hstmt data-ptr size))) 677 678 679 ;;;; dso+ 732 680 (defun %sql-more-results (hstmt) 733 681 (let ((res (SQLMoreResults hstmt))) -
combined/src/odbc/parameter.lisp
r1 r2.1.1 54 54 param))) 55 55 56 ;;;; dso: not so sure about this one and its callers 56 57 (defun bind-parameter (hstmt pos param) 57 58 (setf (slot-value param 'ind-ptr) 58 (cffi:foreign-alloc :long))59 (cffi:foreign-alloc 'sql-len)) 59 60 (%sql-bind-parameter 60 61 hstmt … … 175 176 (setf parameter-type $SQL_INTEGER) 176 177 (setf buffer-length 4) 177 (setf value-ptr (cffi:foreign-alloc :long))))178 (setf value-ptr (cffi:foreign-alloc 'sql-integer)))) 178 179 179 180 (defmethod set-parameter-value ((param integer-parameter) value) … … 324 325 ;; we store the position there 325 326 (setf buffer-length 4) 326 (setf value-ptr (cffi:foreign-alloc :long))))327 (setf value-ptr (cffi:foreign-alloc 'sql-len)))) 327 328 328 329 (defmethod set-parameter-value ((param clob-parameter) value) … … 374 375 ;; we store the position there 375 376 (setf buffer-length 4) 376 (setf value-ptr (cffi:foreign-alloc :long))))377 (setf value-ptr (cffi:foreign-alloc 'sql-len)))) 377 378 378 379 (defmethod set-parameter-value ((param uclob-parameter) value) … … 423 424 ;; we store the position there 424 425 (setf buffer-length 4) 425 (setf value-ptr (cffi:foreign-alloc :long))))426 (setf value-ptr (cffi:foreign-alloc 'sql-len)))) 426 427 427 428 (defmethod set-parameter-value ((param blob-parameter) value)
Note: See TracChangeset
for help on using the changeset viewer.
