+2010-02-11 Kevin Rosenberg <kevin@rosenberg.net>
+ * multiple-files: Further internationalization. Change
+ UFFI:CONVERT-RAW-FIELD and UFFI:CONVERT-FROM-FOREIGN-STRINGS
+ invocations to use the foreign character set encoding of the
+ database object.
+
2010-02-11 Nathan Bird <nathan@acceleration.net>
* MSSQL: better support for fddl 'date type.
-2010-02-20 Kevin Rosenberg <kevin@rosenberg.net>
+2010-02-11 Kevin Rosenberg <kevin@rosenberg.net>
* Makefile.common, uffi/Makefile, db-mysql/Makefile:
Better support OS X Snow Leopard by building universal
(x86_64,i386) dylib bundles
(uffi:deref-array row '(:array
(* :unsigned-char))
i)
- result-types i
- (uffi:deref-array lengths '(:array :unsigned-long)
- i)))))
+ (nth i result-types)
+ :length
+ (uffi:deref-array lengths '(:array :unsigned-long) i)
+ :encoding (encoding database)))))
(when field-names
(result-field-names res-ptr))))
(mysql-free-result res-ptr))
(setf (car rest)
(convert-raw-field
(uffi:deref-array row '(:array (* :unsigned-char)) i)
- types
- i
- (uffi:deref-array lengths '(:array :unsigned-long) i))))
+ (nth i types)
+ :length
+ (uffi:deref-array lengths '(:array :unsigned-long) i)
+ :encoding (encoding database))))
list)))
((#.mysql-field-types#var-string #.mysql-field-types#string
#.mysql-field-types#tiny-blob #.mysql-field-types#blob
#.mysql-field-types#medium-blob #.mysql-field-types#long-blob)
- (uffi:convert-from-foreign-string buffer))
- (#.mysql-field-types#tiny
- (uffi:ensure-char-integer
- (uffi:deref-pointer buffer :byte)))
- (#.mysql-field-types#short
- (uffi:deref-pointer buffer :short))
- (#.mysql-field-types#long
- (uffi:deref-pointer buffer :int))
- #+64bit
- (#.mysql-field-types#longlong
+ (uffi:convert-from-foreign-string buffer :encoding (encoding (database stmt))))
+ (#.mysql-field-types#tiny
+ (uffi:ensure-char-integer
+ (uffi:deref-pointer buffer :byte)))
+ (#.mysql-field-types#short
+ (uffi:deref-pointer buffer :short))
+ (#.mysql-field-types#long
+ (uffi:deref-pointer buffer :int))
+ #+64bit
+ (#.mysql-field-types#longlong
(uffi:deref-pointer buffer :long))
- (#.mysql-field-types#float
- (uffi:deref-pointer buffer :float))
- (#.mysql-field-types#double
- (uffi:deref-pointer buffer :double))
+ (#.mysql-field-types#float
+ (uffi:deref-pointer buffer :float))
+ (#.mysql-field-types#double
+ (uffi:deref-pointer buffer :double))
((#.mysql-field-types#time #.mysql-field-types#date
#.mysql-field-types#datetime #.mysql-field-types#timestamp)
(let ((year (uffi:get-slot-value buffer 'mysql-time 'mysql::year))
(day (uffi:get-slot-value buffer 'mysql-time 'mysql::day))
(hour (uffi:get-slot-value buffer 'mysql-time 'mysql::hour))
(minute (uffi:get-slot-value buffer 'mysql-time 'mysql::minute))
- (second (uffi:get-slot-value buffer 'mysql-time 'mysql::second)))
+ (second (uffi:get-slot-value buffer 'mysql-time 'mysql::second)))
(db-timestring
(make-time :year year :month month :day day :hour hour
:minute minute :second second))))
(uffi:char-array-to-pointer errbuf)
+errbuf-len+ +oci-htype-error+))
(let ((subcode (uffi:deref-pointer errcode 'sb4))
- (errstr (uffi:convert-from-foreign-string errbuf)))
+ (errstr (uffi:convert-from-foreign-string
+ errbuf
+ :encoding (when database (encoding database)))))
(uffi:free-foreign-object errcode)
(uffi:free-foreign-object errbuf)
(unless (and nulls-ok (= subcode +null-value-returned+))
(uffi:def-type string-pointer (* :unsigned-char))
-(defun deref-oci-string (arrayptr string-index size)
+(defun deref-oci-string (arrayptr string-index size encoding)
(declare (type string-pointer arrayptr))
(declare (type (mod #.+n-buf-rows+) string-index))
(declare (type (and unsigned-byte fixnum) size))
(let ((str (uffi:convert-from-foreign-string
(uffi:make-pointer
(+ (uffi:pointer-address arrayptr) (* string-index size))
- :unsigned-char))))
+ :unsigned-char)
+ :encoding encoding)))
(if (string-equal str "NULL") nil str)))
;; the OCI library, part Z: no-longer used logic to convert from
; from it after that..
-(defun fetch-row (qc &optional (eof-errorp t) eof-value)
+(defun fetch-row (qc (eof-errorp t) eof-value encoding)
(declare (optimize (speed 3)))
(cond ((zerop (qc-n-from-oci qc))
(if eof-errorp
((>= (qc-n-to-dbi qc)
(qc-n-from-oci qc))
(refill-qc-buffers qc)
- (fetch-row qc nil eof-value))
+ (fetch-row qc nil eof-value encoding))
(t
(let ((cds (qc-cds qc))
(reversed-result nil)
(deref-vp errhp))
(setq colname-string (uffi:convert-from-foreign-string
(uffi:deref-pointer colname '(* :unsigned-char))
- :length (uffi:deref-pointer colnamelen 'ub4))))
+ :length (uffi:deref-pointer colnamelen 'ub4)
+ :encoding (encoding database))))
(push (make-cd :name colname-string
:sizeof sizeof
:buffer buffer
(do ((reversed-result nil))
(nil)
(let* ((eof-value :eof)
- (row (fetch-row cursor nil eof-value)))
+ (row (fetch-row cursor nil eof-value (encoding database))))
(when (eq row eof-value)
(close-query cursor)
(if field-names
(defmethod database-store-next-row (result-set (database oracle-database) list)
(let* ((eof-value :eof)
- (row (fetch-row result-set nil eof-value)))
+ (row (fetch-row result-set nil eof-value (encoding database))))
(unless (eq eof-value row)
(loop for i from 0 below (length row)
do (setf (nth i list) (nth i row)))
(t
nil)))))
-(defun tidy-error-message (message)
+(defun tidy-error-message (message &optional encoding)
(unless (stringp message)
- (setq message (uffi:convert-from-foreign-string message)))
+ (setq message (uffi:convert-from-foreign-string message :encoding encoding)))
(let ((message (string-right-trim '(#\Return #\Newline) message)))
(cond
((< (length message) (length "ERROR:"))
(error 'sql-database-data-error
:database database
:expression query-expression
- :message (tidy-error-message (PQerrorMessage conn-ptr))))
+ :message (tidy-error-message (PQerrorMessage conn-ptr) (encoding database))))
(unwind-protect
(case (PQresultStatus result)
;; User gave a command rather than a query
(if (zerop (PQgetisnull result tuple-index i))
(convert-raw-field
(PQgetvalue result tuple-index i)
- result-types i)
+ (nth i result-types)
+ :encoding (encoding database))
nil)))))
(if field-names
(values res (result-field-names num-fields result))
:expression query-expression
:error-id (PQresultErrorField result +PG-DIAG-SQLSTATE+)
:message (tidy-error-message
- (PQresultErrorMessage result)))))
+ (PQresultErrorMessage result)
+ (encoding database)))))
(PQclear result))))))
(defun result-field-names (num-fields result)
(error 'sql-database-data-error
:database database
:expression sql-expression
- :message (tidy-error-message (PQerrorMessage conn-ptr))))
+ :message (tidy-error-message (PQerrorMessage conn-ptr)
+ (encoding databse))))
(unwind-protect
(case (PQresultStatus result)
(#.pgsql-exec-status-type#command-ok
:expression sql-expression
:error-id (PQresultErrorField result +PG-DIAG-SQLSTATE+)
:message (tidy-error-message
- (PQresultErrorMessage result)))))
+ (PQresultErrorMessage result)
+ (encoding database)))))
(PQclear result))))))
(defstruct postgresql-result-set
(error 'sql-database-data-error
:database database
:expression query-expression
- :message (tidy-error-message (PQerrorMessage conn-ptr))))
+ :message (tidy-error-message (PQerrorMessage conn-ptr)
+ (encoding database))))
(case (PQresultStatus result)
((#.pgsql-exec-status-type#empty-query
#.pgsql-exec-status-type#tuples-ok)
:expression query-expression
:error-id (PQresultErrorField result +PG-DIAG-SQLSTATE+)
:message (tidy-error-message
- (PQresultErrorMessage result)))
+ (PQresultErrorMessage result)
+ (encoding database)))
(PQclear result))))))))
(defmethod database-dump-result-set (result-set (database postgresql-database))
(if (zerop (PQgetisnull result tuple-index i))
(convert-raw-field
(PQgetvalue result tuple-index i)
- types i)
+ (nth i types)
+ :encoding (encoding database))
nil))
finally
(incf (postgresql-result-set-tuple-index result-set))
length :unsigned t))
(when (= (lo-read ptr fd buffer length) length)
(setf result (uffi:convert-from-foreign-string
- buffer :length length :null-terminated-p nil))))))
+ buffer :length length :null-terminated-p nil
+ :encoding (encoding database)))))))
(progn
(when buffer (uffi:free-foreign-object buffer))
(when (and fd (>= fd 0)) (lo-close ptr fd))
(null-pointer-p row))
(declaim (inline sqlite-aref))
-(defun sqlite-aref (a n)
+(defun sqlite-aref (a n encoding)
(declare (type sqlite-row-pointer-type a))
(convert-from-foreign-string
- (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array (* :unsigned-char)) n)))
+ (deref-array (deref-pointer a 'sqlite-row-pointer) '(:array (* :unsigned-char)) n)
+ :encoding encoding))
(declaim (inline sqlite-raw-aref))
(defun sqlite-raw-aref (a n)
(when (> n-col 0)
(when field-names
(setf col-names (loop for i from 0 below n-col
- collect (sqlite:sqlite-aref sqlite-col-names i))))
+ collect (sqlite:sqlite-aref sqlite-col-names i (encoding database)))))
(let ((canonicalized-result-types
(canonicalize-result-types result-types n-col sqlite-col-names)))
(flet ((extract-row-data (row)
(loop for i from 0 below n-col
collect (clsql-uffi:convert-raw-field
(sqlite:sqlite-raw-aref row i)
- canonicalized-result-types i))))
+ (nth i canonicalized-result-types)
+ :encoding (encoding database)))))
(push (extract-row-data new-row) rows)
;; Read subsequent rows.
do (setf (car rest)
(clsql-uffi:convert-raw-field
(sqlite:sqlite-raw-aref row i)
- result-types
- i)))
+ (nth i result-types)
+ :encoding (encoding database))))
(sqlite:sqlite-free-row row)
t))))
;;;;
;;;; Name: sqlite-sql.lisp
;;;; Purpose: High-level SQLite3 interface
-;;;; Authors: Aurelio Bignoli
+;;;; Authors: Aurelio Bignoli & Kevin Rosenberg
;;;; Created: Oct 2004
;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2004 by Aurelio Bignoli
+;;;; This file, part of CLSQL, is Copyright (c) 2004-2010 by Aurelio Bignoli & Kevin Rosenberg
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
(if (eq (first types) :blob)
(clsql-uffi:convert-raw-field
(sqlite3:sqlite3-column-blob stmt i)
- types 0
- (sqlite3:sqlite3-column-bytes stmt i))
+ (car types)
+ :length (sqlite3:sqlite3-column-bytes stmt i)
+ :encoding (encoding database))
(clsql-uffi:convert-raw-field
(sqlite3:sqlite3-column-text stmt i)
- types 0))))
+ (car types)
+ :encoding (encoding database)))))
;; Advance result set cursor.
(handler-case
(unless (sqlite3:sqlite3-step stmt)
collect (if (eq (first types) :blob)
(clsql-uffi:convert-raw-field
(sqlite3:sqlite3-column-blob stmt i)
- types 0
- (sqlite3:sqlite3-column-bytes stmt i))
+ (car types)
+ :length (sqlite3:sqlite3-column-bytes stmt i)
+ :encoding (encoding database))
(clsql-uffi:convert-raw-field
(sqlite3:sqlite3-column-text stmt i)
- types 0)))))
+ (car types)
+ :encoding (encoding database))))))
(when field-names
(setf col-names (loop for n from 0 below n-col
collect (sqlite3:sqlite3-column-name stmt n))))
(type char-ptr-def char-ptr))
(c-strtoul char-ptr uffi:+null-cstring-pointer+ 10))
-(defun convert-raw-field (char-ptr types index &optional length)
+(defun convert-raw-field (char-ptr type &key length encoding)
(declare (optimize (speed 3) (safety 0) (space 0))
(type char-ptr-def char-ptr))
- (let ((type (if (consp types)
- (nth index types)
- types)))
- (cond
- ((uffi:null-pointer-p char-ptr)
- nil)
- (t
- (case type
- (:double
- (atof char-ptr))
- (:int
- (atol char-ptr))
- (:int32
- (atoi char-ptr))
- (:uint32
- (strtoul char-ptr))
- (:uint
- (strtoul char-ptr))
- ((:int64 :uint64)
- (uffi:with-foreign-object (high32-ptr :unsigned-int)
- (let ((low32 (atol64 char-ptr high32-ptr))
- (high32 (uffi:deref-pointer high32-ptr :unsigned-int)))
- (if (zerop high32)
- low32
+ (cond
+ ((uffi:null-pointer-p char-ptr)
+ nil)
+ (t
+ (case type
+ (:double
+ (atof char-ptr))
+ (:int
+ (atol char-ptr))
+ (:int32
+ (atoi char-ptr))
+ (:uint32
+ (strtoul char-ptr))
+ (:uint
+ (strtoul char-ptr))
+ ((:int64 :uint64)
+ (uffi:with-foreign-object (high32-ptr :unsigned-int)
+ (let ((low32 (atol64 char-ptr high32-ptr))
+ (high32 (uffi:deref-pointer high32-ptr :unsigned-int)))
+ (if (zerop high32)
+ low32
(make-64-bit-integer high32 low32)))))
- (:blob
- (if length
- (uffi:convert-from-foreign-usb8 char-ptr length)
+ (:blob
+ (if length
+ (uffi:convert-from-foreign-usb8 char-ptr length)
(error "Can't return blob since length is not specified.")))
- (t
- ;; sb-unicode doesn't work converting with length, assume
- ;; that string is null terminated
- #+sb-unicode
- (uffi:convert-from-foreign-string char-ptr)
- #-sb-unicode
- (if length
- (uffi:convert-from-foreign-string char-ptr
- :null-terminated-p nil
- :length length)
- (uffi:convert-from-foreign-string char-ptr))))))))
-
+ (t
+ (uffi:convert-from-foreign-string char-ptr
+ :null-terminated-p nil
+ :length length
+ :encoding encoding))))))
projects / clsql.git / commitdiff