suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix ODBC numeric/decimal param precision and scale

Browse Source 
closes PR 14171

But wasn't able to get numeric/decimal working on "SQL Server" driver,
only "SQL Server Native Client" driver.
This commit is contained in:
Ryan Culpepper 2013-11-21 14:53:21 -05:00
parent 991659a9e3
commit 7e8ed02704
5 changed files with 113 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/db-pkgs/db-doc/db/scribblings/notes.scrbl
View File

@ -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.

92
pkgs/db-pkgs/db-lib/db/private/odbc/connection.rkt
View File

@ -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)]

6
pkgs/db-pkgs/db-lib/db/private/odbc/dbsystem.rkt
View File

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

8
pkgs/db-pkgs/db-lib/db/private/odbc/ffi-constants.rkt
View File

@ -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)

35
pkgs/db-pkgs/db-lib/db/private/odbc/ffi.rkt
View File

@ -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)