diff --git a/pkgs/db-pkgs/db-doc/db/scribblings/notes.scrbl b/pkgs/db-pkgs/db-doc/db/scribblings/notes.scrbl index 4fae2a7e30..c9fa1b35b1 100644 --- a/pkgs/db-pkgs/db-doc/db/scribblings/notes.scrbl +++ b/pkgs/db-pkgs/db-doc/db/scribblings/notes.scrbl @@ -257,5 +257,10 @@ Maybe Oracle bug? See: @subsection{SQL Server ODBC Driver} -Basic SQL Server support has been verified on Windows (32-bit only), +Basic SQL Server support has been verified on Windows, but the automated test suite has not yet been adapted and run. + +The ``SQL Server'' driver refuses to accept @tt{NUMERIC} or +@tt{DECIMAL} parameters, producing the error ``Invalid precision value +(SQLSTATE: HY104).'' If possible, use the ``Native SQL Server'' +driver instead. diff --git a/pkgs/db-pkgs/db-lib/db/private/odbc/connection.rkt b/pkgs/db-pkgs/db-lib/db/private/odbc/connection.rkt index 8a57ca9936..3aa137e03d 100644 --- a/pkgs/db-pkgs/db-lib/db/private/odbc/connection.rkt +++ b/pkgs/db-pkgs/db-lib/db/private/odbc/connection.rkt @@ -101,20 +101,21 @@ (load-param fsym db stmt i param param-typeid))]) (handle-status fsym (SQLExecute stmt) stmt) (strong-void param-bufs)) - (let* ([result-dvecs (send pst get-result-dvecs)] - [rows - (and (not cursor?) - (pair? result-dvecs) - (fetch* fsym stmt (map field-dvec->typeid result-dvecs) #f +inf.0))]) - (unless cursor? (send pst after-exec #f)) - (cond [(and (pair? result-dvecs) (not cursor?)) - (rows-result (map field-dvec->field-info result-dvecs) rows)] - [(and (pair? result-dvecs) cursor?) - (cursor-result (map field-dvec->field-info result-dvecs) - pst - (list (map field-dvec->typeid result-dvecs) - (box #f)))] - [else (simple-result '())])))) + (define result-dvecs (send pst get-result-dvecs)) + (set-result-descriptors stmt result-dvecs) + (define rows + (and (not cursor?) + (pair? result-dvecs) + (fetch* fsym stmt (map field-dvec->typeid result-dvecs) #f +inf.0))) + (unless cursor? (send pst after-exec #f)) + (cond [(and (pair? result-dvecs) (not cursor?)) + (rows-result (map field-dvec->field-info result-dvecs) rows)] + [(and (pair? result-dvecs) cursor?) + (cursor-result (map field-dvec->field-info result-dvecs) + pst + (list (map field-dvec->typeid result-dvecs) + (box #f)))] + [else (simple-result '())]))) (define/public (fetch/cursor fsym cursor fetch-size) (let ([pst (cursor-result-pst cursor)] @@ -133,11 +134,11 @@ (define/private (load-param fsym db stmt i param typeid) ;; NOTE: param buffers must not move between bind and execute ;; So use buffer utils from ffi.rkt (copy-buffer, etc) - (define (bind ctype sqltype buf) + (define (bind ctype sqltype buf [prec 0] [scale 0]) (let* ([lenbuf (int->buffer (if buf (bytes-length buf) SQL_NULL_DATA))] [status - (SQLBindParameter stmt i SQL_PARAM_INPUT ctype sqltype 0 0 buf lenbuf)]) + (SQLBindParameter stmt i SQL_PARAM_INPUT ctype sqltype prec scale buf lenbuf)]) (handle-status fsym status stmt) (if buf (cons buf lenbuf) lenbuf))) ;; If the typeid is UNKNOWN, then choose appropriate type based on data, @@ -160,22 +161,29 @@ (bind SQL_C_BINARY (if unknown-type? SQL_BINARY typeid) (copy-buffer param))] [(pair? param) ;; Represents numeric/decimal decomposed as scaled integer - (bind SQL_C_NUMERIC typeid - (copy-buffer - (let ([ma (car param)] - [ex (cdr param)]) - (apply bytes-append - ;; ODBC docs claim max precision is 15 ... - (bytes (if (zero? ma) 1 (+ 1 (order-of-magnitude (abs ma)))) - ex - (if (negative? ma) 0 1)) - ;; 16 bytes of unsigned little-endian data (4 chunks of 4 bytes) - (let loop ([i 0] [ma (abs ma)]) - (if (< i 4) - (let-values ([(q r) (quotient/remainder ma (expt 2 32))]) - (cons (integer->integer-bytes r 4 #f #f) - (loop (add1 i) q))) - null))))))] + (let* ([ma (car param)] + [ex (cdr param)] + ;; ODBC docs claim max precision is 15 ... + [prec-byte (if (zero? ma) 1 (+ 1 (order-of-magnitude (abs ma))))] + [sign-byte (if (negative? ma) 0 1)] ;; FIXME: negative is 2 in ODBC 3.5 ??? + [digits-bytess + ;; 16 bytes of unsigned little-endian data (4 chunks of 4 bytes) + (let loop ([i 0] [ma (abs ma)]) + (if (< i 4) + (let-values ([(q r) (quotient/remainder ma (expt 2 32))]) + (cons (integer->integer-bytes r 4 #f #f) + (loop (add1 i) q))) + null))] + [numeric-bytes + (apply bytes-append (bytes prec-byte ex sign-byte) digits-bytess)] + [numeric-buffer (copy-buffer numeric-bytes)]) + ;; Example: http://support.microsoft.com/kb/181254 + ;; and: http://msdn.microsoft.com/en-us/library/ms712567%28v=vs.85%29.aspx + ;; Call bind first. + (bind SQL_C_NUMERIC typeid numeric-buffer prec-byte ex) + ;; Then set descriptor attributes. + (set-numeric-descriptors (SQLGetStmtAttr/HDesc stmt SQL_ATTR_APP_PARAM_DESC) + i prec-byte ex numeric-buffer))] [(real? param) (cond [(or (= typeid SQL_NUMERIC) (= typeid SQL_DECIMAL)) (bind SQL_C_CHAR typeid @@ -239,6 +247,24 @@ '("given" value) param "typeid" typeid)])) + (define/private (set-result-descriptors stmt dvecs) + (for ([i (in-naturals 1)] + [dvec (in-list dvecs)]) + (define typeid (field-dvec->typeid dvec)) + (cond [(or (= typeid SQL_DECIMAL) + (= typeid SQL_NUMERIC)) + (define hdesc (SQLGetStmtAttr/HDesc stmt SQL_ATTR_APP_ROW_DESC)) + (define size (field-dvec->size dvec)) + (define digits (field-dvec->digits dvec)) + (set-numeric-descriptors hdesc i size digits #f)] + [else (void)]))) + + (define/private (set-numeric-descriptors hdesc i prec ex buf) + (SQLSetDescField/Int hdesc i SQL_DESC_TYPE SQL_C_NUMERIC) + (SQLSetDescField/Int hdesc i SQL_DESC_PRECISION prec) + (SQLSetDescField/Int hdesc i SQL_DESC_SCALE ex) + (when buf (SQLSetDescField/Ptr hdesc i SQL_DESC_DATA_PTR buf (bytes-length buf)))) + (define/private (fetch* fsym stmt result-typeids end-box limit) ;; scratchbuf: create a single buffer here to try to reduce garbage ;; Don't make too big; otherwise bad for queries with only small data. @@ -381,7 +407,7 @@ (get-string)] [(or (= typeid SQL_DECIMAL) (= typeid SQL_NUMERIC)) - (let ([fields (get-int-list '(1 1 1 4 4 4 4) SQL_C_NUMERIC)]) + (let ([fields (get-int-list '(1 1 1 4 4 4 4) SQL_ARD_TYPE)]) (cond [(list? fields) (let* ([precision (first fields)] [scale (second fields)] diff --git a/pkgs/db-pkgs/db-lib/db/private/odbc/dbsystem.rkt b/pkgs/db-pkgs/db-lib/db/private/odbc/dbsystem.rkt index bdc61ff39f..704b50874b 100644 --- a/pkgs/db-pkgs/db-lib/db/private/odbc/dbsystem.rkt +++ b/pkgs/db-pkgs/db-lib/db/private/odbc/dbsystem.rkt @@ -7,6 +7,8 @@ (provide dbsystem field-dvec->field-info field-dvec->typeid + field-dvec->size + field-dvec->digits supported-typeid? classify-odbc-sql) @@ -44,6 +46,10 @@ (define (field-dvec->typeid dvec) (vector-ref dvec 1)) +(define (field-dvec->size dvec) + (vector-ref dvec 2)) +(define (field-dvec->digits dvec) + (vector-ref dvec 3)) ;; ---- diff --git a/pkgs/db-pkgs/db-lib/db/private/odbc/ffi-constants.rkt b/pkgs/db-pkgs/db-lib/db/private/odbc/ffi-constants.rkt index 0975e5c02c..a53f524316 100644 --- a/pkgs/db-pkgs/db-lib/db/private/odbc/ffi-constants.rkt +++ b/pkgs/db-pkgs/db-lib/db/private/odbc/ffi-constants.rkt @@ -129,6 +129,7 @@ (define SQL_C_DOUBLE SQL_DOUBLE) (define SQL_C_NUMERIC SQL_NUMERIC) (define SQL_C_DEFAULT 99) +(define SQL_ARD_TYPE -99) (define SQL_C_DATE SQL_DATE) (define SQL_C_TIME SQL_TIME) @@ -196,3 +197,10 @@ (define SQL_TXN_SERIALIZABLE #x8) (define SQL_DBMS_NAME 17) + +(define SQL_ATTR_APP_PARAM_DESC 10011) +(define SQL_ATTR_APP_ROW_DESC 10010) +(define SQL_DESC_TYPE 1002) +(define SQL_DESC_PRECISION 1005) +(define SQL_DESC_SCALE 1006) +(define SQL_DESC_DATA_PTR 1010) diff --git a/pkgs/db-pkgs/db-lib/db/private/odbc/ffi.rkt b/pkgs/db-pkgs/db-lib/db/private/odbc/ffi.rkt index 62b07a3e88..92e7657980 100644 --- a/pkgs/db-pkgs/db-lib/db/private/odbc/ffi.rkt +++ b/pkgs/db-pkgs/db-lib/db/private/odbc/ffi.rkt @@ -10,6 +10,7 @@ (define-cpointer-type _sqlhenv) (define-cpointer-type _sqlhdbc) (define-cpointer-type _sqlhstmt) +(define-cpointer-type _sqlhdesc) (define _sqllen _long) (define _sqlulen _ulong) @@ -316,7 +317,7 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx (handle : _sqlhstmt) (column : _sqlusmallint) (column-buf : _bytes) - ((bytes-length column-buf) : _sqlsmallint) + (_sqlsmallint = (if column-buf (bytes-length column-buf) 0)) (column-len : (_ptr o _sqlsmallint)) (data-type : (_ptr o _sqlsmallint)) (size : (_ptr o _sqlulen)) @@ -325,6 +326,7 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx -> (status : _sqlreturn) -> (values status (and (ok-status? status) + column-buf (bytes->string/utf-8 column-buf #f 0 column-len)) data-type size digits nullable))) @@ -343,6 +345,37 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx -> (status : _sqlreturn) -> (values status len-or-ind))) +(define-odbc SQLGetStmtAttr/HDesc + (_fun (handle attr) :: + (handle : _sqlhstmt) + (attr : _sqlinteger) + (valptr : (_ptr o _sqlhdesc)) + (buflen : _sqlinteger = 0) + (strlen : _pointer = #f) + -> (status : _sqlreturn) + -> (and (ok-status? status) valptr)) + #:c-id SQLGetStmtAttr) + +(define-odbc SQLSetDescField/Int + (_fun (handle recno fieldid intval) :: + (handle : _sqlhdesc) + (recno : _sqlsmallint) + (fieldid : _sqlsmallint) + (intval : _intptr) ;; declared SQLPOINTER; cast + (buflen : _sqlinteger = 0) + -> (status : _sqlreturn)) + #:c-id SQLSetDescField) + +(define-odbc SQLSetDescField/Ptr + (_fun (handle recno fieldid ptrval buflen) :: + (handle : _sqlhdesc) + (recno : _sqlsmallint) + (fieldid : _sqlsmallint) + (ptrval : _pointer) ;; declared SQLPOINTER; cast + (buflen : _sqlinteger) + -> (status : _sqlreturn)) + #:c-id SQLSetDescField) + (define-odbc SQLFreeStmt (_fun (handle : _sqlhstmt) (option : _sqlusmallint)