X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-odbc%2Fodbc-api.lisp;h=208dafa7536190665644a5709ad9fb99f04eb81b;hb=8b84dd8066b5792cdc5b9570a60fb72c278da677;hp=b20a48aba469295b11880ca8326fec7c196d9d29;hpb=8a0c49946e9569a6402beaa8d2194ceabf9d3d04;p=clsql.git

diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp
index b20a48a..208dafa 100644
--- a/db-odbc/odbc-api.lisp
+++ b/db-odbc/odbc-api.lisp
@@ -48,21 +48,6 @@ May be locally bound to something else if a certain type is necessary.")
                 (char-code (char ,string i))))
         (setf (deref-array char-ptr '(:array :byte) ,size) 0)))))
 
-(defun %cstring-into-vector (ptr vector offset size-in-bytes)
-  (dotimes (i size-in-bytes)
-    (setf (schar vector offset)
-          (ensure-char-character
-              ;; this is MUCH faster than (sb-alien:deref ptr i) even though
-              ;; sb-alien:deref makes more sense. I snagged this by looking at
-              ;; cffi which we had used previously without this bug
-              #+(and sbcl (not cffi))
-              (sb-sys:sap-ref-8 (sb-alien:alien-sap ptr) i)
-              #-(and sbcl (not cffi))
-              (deref-array ptr '(:array :unsigned-char) i)
-       ))
-    (incf offset))
-  offset)
-
 (defmacro with-allocate-foreign-string ((var len) &body body)
   "Safely does uffi:allocate-foreign-string-- making sure we do the uffi:free-foreign-object"
   `(let ((,var))
@@ -880,61 +865,47 @@ May be locally bound to something else if a certain type is necessary.")
 
 
 (defun read-data-in-chunks (hstmt column-nr data-ptr c-type sql-type
-                                      out-len-ptr result-type)
+                            out-len-ptr result-type)
   (declare (type long-ptr-type out-len-ptr)
            (ignore result-type))
+
   (let* ((res (%sql-get-data hstmt column-nr c-type data-ptr
                              +max-precision+ out-len-ptr))
          (out-len (get-cast-long out-len-ptr))
-         (offset 0)
-         (result (case out-len
-                   (#.$SQL_NULL_DATA
-                    (return-from read-data-in-chunks *null*))
-                   (#.$SQL_NO_TOTAL ;; don't know how long it is going to be
-                                    (let ((str (make-array 0 :element-type 'character :adjustable t)))
-                                      (loop do (if (= c-type #.$SQL_CHAR)
-                                                   (let ((data-length (foreign-string-length data-ptr)))
-                                                     (adjust-array str (+ offset data-length)
-                                                                   :initial-element #\?)
-                                                     (setf offset (%cstring-into-vector
-                                                                   data-ptr str
-                                                                   offset
-                                                                   data-length)))
-                                                 (error 'clsql:sql-database-error :message "wrong type. preliminary."))
-                                            while (and (= res $SQL_SUCCESS_WITH_INFO)
-                                                       (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt)
-                                                              "01004"))
-                                            do (setf res (%sql-get-data hstmt column-nr c-type data-ptr
-                                                                        +max-precision+ out-len-ptr)))
-                                      (setf str (coerce str 'string))
-                                      (if (= sql-type $SQL_DECIMAL)
-                                          (let ((*read-base* 10))
-                                            (read-from-string str))
-                                        str)))
-                   (otherwise
-                    (let ((str (make-string out-len)))
-                      (loop
-                        do
-                           (if (= c-type #.$SQL_CHAR)
-                               (setf offset (%cstring-into-vector ;string
-                                             data-ptr str
-                                             offset
-                                             (min out-len (1- +max-precision+))))
-                               (error 'clsql:sql-database-error :message "wrong type. preliminary."))
-                        while
-                        (and (= res $SQL_SUCCESS_WITH_INFO)
-                             (>= out-len +max-precision+))
-                        do (setf res  (%sql-get-data hstmt column-nr c-type data-ptr
-                                                     +max-precision+ out-len-ptr)
-                                 out-len (get-cast-long out-len-ptr)))
-                      (if (= sql-type $SQL_DECIMAL)
-                          (let ((*read-base* 10)
-                                (*read-default-float-format* 'double-float))
-                            (read-from-string str))
-                          str))))))
-
-    (setf (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE) #.$SQL_NO_TOTAL) ;; reset the out length for the next row
-    result))
+         (result (if (equal out-len #.$SQL_NULL_DATA)
+                     (return-from read-data-in-chunks *null*)
+                     
+                     ;;this isn't the most efficient way of doing it:
+                     ;;the foreign string gets copied to lisp, then
+                     ;;that is copied into the final string. However,
+                     ;;the previous impl that tried to copy one
+                     ;;character over at a time failed miserably on
+                     ;;multibyte characters.
+                     ;;
+                     ;;In the face of multibyte characters, the out-len
+                     ;;tells us the length in bytes but that doesn't
+                     ;;particularly help us here in allocating a lisp
+                     ;;array. So our best strategy is to just let the
+                     ;;foreign library that's already dealing with
+                     ;;encodings do its thing.
+                   
+                     (with-output-to-string (str)
+                       (loop do (if (= c-type #.$SQL_CHAR)
+                                    (write-sequence (get-cast-foreign-string data-ptr) str)
+                                    (error 'clsql:sql-database-error
+                                           :message "wrong type. preliminary."))
+                             while (and (= res $SQL_SUCCESS_WITH_INFO)
+                                        (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt)
+                                               "01004"))
+                             do (setf res (%sql-get-data hstmt column-nr c-type data-ptr
+                                                         +max-precision+ out-len-ptr)))))))
+
+    ;; reset the out length for the next row
+    (setf (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE) #.$SQL_NO_TOTAL)
+    (if (= sql-type $SQL_DECIMAL)
+        (let ((*read-base* 10))
+          (read-from-string result))
+        result)))
 
 
 (def-type c-timestamp-ptr-type (* (:struct sql-c-timestamp)))