(with-slots (column-count column-data-ptrs column-c-types column-sql-types
column-out-len-ptrs column-precisions hstmt computed-result-types)
query
- (labels
- ((create-column-fetcher (result-type data-ptr c-type sql-type out-len-ptr precision column-nr)
- (lambda ()
- (cond ((< 0 precision (query-width query))
- (read-data data-ptr c-type sql-type out-len-ptr result-type))
- ((zerop (get-cast-long out-len-ptr))
- nil)
- (t
- (read-data-in-chunks hstmt column-nr data-ptr c-type sql-type
- out-len-ptr result-type))))))
- (let ((fetchers (make-array column-count :fill-pointer 0 :element-type 'function)))
- ;;; Map across the columns, creating a set of fetch functions
- (loop for result-type across computed-result-types
- for data-ptr across column-data-ptrs
- for c-type across column-c-types
- for sql-type across column-sql-types
- for out-len-ptr across column-out-len-ptrs
- for precision across column-precisions
- for column-nr from 0 ; column count is zero based in lisp
- do
- (vector-push (create-column-fetcher result-type data-ptr c-type sql-type
- out-len-ptr precision column-nr)
- fetchers))
- ;; keep fetching rows until we meet the count parameter,
- ;; or the %sql-fetch says we're done.
- (loop for i from 0
- until (or (and count (= i count))
- (= (%sql-fetch hstmt) odbc::$SQL_NO_DATA_FOUND))
- ;;collect the results of the fetch functions to make a row.
- collect (map 'list #'funcall fetchers) into rows
- finally (return (values rows query i))
- ))))))
+ (let* ((rows-fetched 0)
+ (rows
+ (loop for i from 0
+ until (or (and count (= i count))
+ (= (%sql-fetch hstmt) odbc::$SQL_NO_DATA_FOUND))
+ collect
+ (loop for result-type across computed-result-types
+ for data-ptr across column-data-ptrs
+ for c-type across column-c-types
+ for sql-type across column-sql-types
+ for out-len-ptr across column-out-len-ptrs
+ for precision across column-precisions
+ for j from 0 ; column count is zero based in lisp
+ collect
+ (progn
+ (incf rows-fetched)
+ (cond ((< 0 precision (query-width query))
+ (read-data data-ptr c-type sql-type out-len-ptr result-type))
+ ((zerop (get-cast-long out-len-ptr))
+ nil)
+ (t
+ (read-data-in-chunks hstmt j data-ptr c-type sql-type
+ out-len-ptr result-type))))))))
+ (values rows query rows-fetched)))))
(defun db-query (database query-expression &key result-types width)
(let ((free-query (get-free-query database)))
(setf computed-result-types (make-array column-count))
(dotimes (i column-count)
(setf (aref computed-result-types i)
- (cond
- ((consp result-types)
- (nth i result-types))
- ((eq result-types :auto)
- (if (eq (aref column-sql-types i) odbc::$SQL_BIGINT)
- :number
- (case (aref column-c-types i)
- (#.odbc::$SQL_C_SLONG :int)
- (#.odbc::$SQL_C_DOUBLE :double)
- (#.odbc::$SQL_C_FLOAT :float)
- (#.odbc::$SQL_C_SSHORT :short)
- (#.odbc::$SQL_C_STINYINT :short)
- (#.odbc::$SQL_BIGINT :short)
- (t t))))
- (t
- t)))))
+ (cond
+ ((consp result-types)
+ (nth i result-types))
+ ((eq result-types :auto)
+ (case (aref column-c-types i)
+ (#.odbc::$SQL_C_SLONG :int)
+ (#.odbc::$SQL_C_DOUBLE :double)
+ (#.odbc::$SQL_C_FLOAT :float)
+ (#.odbc::$SQL_C_SSHORT :short)
+ (#.odbc::$SQL_C_STINYINT :short)
+ (#.odbc::$SQL_C_SBIGINT #.odbc::$ODBC-BIG-TYPE)
+ (t t)))
+ (t t)))))
query)
(defun db-close-query (query &key drop-p)
(defun sql-to-lisp-type (sql-type)
(ecase sql-type
((#.odbc::$SQL_CHAR #.odbc::$SQL_VARCHAR #.odbc::$SQL_LONGVARCHAR) :string)
- ((#.odbc::$SQL_NUMERIC #.odbc::$SQL_DECIMAL #.odbc::$SQL_BIGINT) :string) ; ??
+ ((#.odbc::$SQL_NUMERIC #.odbc::$SQL_DECIMAL ) :string) ; ??
+ (#.odbc::$SQL_BIGINT #.odbc::$ODBC-BIG-TYPE)
(#.odbc::$SQL_INTEGER #.odbc::$ODBC-LONG-TYPE)
(#.odbc::$SQL_SMALLINT :short)
((#.odbc::$SQL_FLOAT #.odbc::$SQL_DOUBLE) #.odbc::$ODBC-LONG-TYPE)