From: Kevin Rosenberg Date: Thu, 11 Feb 2010 20:59:31 +0000 (-0700) Subject: Further internationalization. X-Git-Tag: v5.0.3~1 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=fe6d36c16c61c855fc3b0c0c7c07f3cf3de4241d 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. --- diff --git a/ChangeLog b/ChangeLog index d1474b4..aef72fc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,7 +1,13 @@ +2010-02-11 Kevin Rosenberg + * 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 * MSSQL: better support for fddl 'date type. -2010-02-20 Kevin Rosenberg +2010-02-11 Kevin Rosenberg * Makefile.common, uffi/Makefile, db-mysql/Makefile: Better support OS X Snow Leopard by building universal (x86_64,i386) dylib bundles diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index db98e63..d3fbc43 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -217,9 +217,10 @@ (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)) @@ -293,9 +294,10 @@ (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))) @@ -684,21 +686,21 @@ ((#.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)) @@ -706,7 +708,7 @@ (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)))) diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index 8475f47..976dd19 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -166,7 +166,9 @@ the length of that format.") (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+)) @@ -215,14 +217,15 @@ the length of that format.") (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 @@ -402,7 +405,7 @@ the length of that format.") ; 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 @@ -412,7 +415,7 @@ the length of that format.") ((>= (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) @@ -721,7 +724,8 @@ the length of that format.") (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 @@ -894,7 +898,7 @@ the length of that format.") (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 @@ -1019,7 +1023,7 @@ the length of that format.") (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))) diff --git a/db-postgresql/postgresql-sql.lisp b/db-postgresql/postgresql-sql.lisp index aad11a0..462c447 100644 --- a/db-postgresql/postgresql-sql.lisp +++ b/db-postgresql/postgresql-sql.lisp @@ -55,9 +55,9 @@ (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:")) @@ -155,7 +155,7 @@ (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 @@ -176,7 +176,8 @@ (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)) @@ -187,7 +188,8 @@ :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) @@ -207,7 +209,8 @@ (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 @@ -222,7 +225,8 @@ :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 @@ -244,7 +248,8 @@ (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) @@ -269,7 +274,8 @@ :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)) @@ -294,7 +300,8 @@ (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)) @@ -364,7 +371,8 @@ 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)) diff --git a/db-sqlite/sqlite-api.lisp b/db-sqlite/sqlite-api.lisp index 6e06a15..b25653f 100644 --- a/db-sqlite/sqlite-api.lisp +++ b/db-sqlite/sqlite-api.lisp @@ -305,10 +305,11 @@ (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) diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index 0b99945..a2bc7cd 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -97,7 +97,7 @@ (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) @@ -105,7 +105,8 @@ (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. @@ -224,8 +225,8 @@ 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)))) diff --git a/db-sqlite3/sqlite3-sql.lisp b/db-sqlite3/sqlite3-sql.lisp index c51a543..927716a 100644 --- a/db-sqlite3/sqlite3-sql.lisp +++ b/db-sqlite3/sqlite3-sql.lisp @@ -4,10 +4,10 @@ ;;;; ;;;; 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 @@ -168,11 +168,13 @@ (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) @@ -201,11 +203,13 @@ 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)))) diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp index 03ce074..7a4dbbb 100644 --- a/uffi/clsql-uffi.lisp +++ b/uffi/clsql-uffi.lisp @@ -108,47 +108,37 @@ (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))))))