From 7e2b9390d312a945100f1e0bbe60525531b97980 Mon Sep 17 00:00:00 2001 From: Kevin Rosenberg Date: Sun, 7 Feb 2010 22:36:26 -0700 Subject: [PATCH] Version 5.0.1: Add encoding slot to database object --- ChangeLog | 7 +++++++ db-mysql/mysql-sql.lisp | 9 ++++++--- debian/changelog | 6 ++++++ sql/base-classes.lisp | 8 +++++--- sql/database.lisp | 28 ++++++++++++++++++++++++---- sql/package.lisp | 1 + 6 files changed, 49 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0c26481..dc2a4b4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2010-02-07 Kevin Rosenberg + * Version 5.0.1 + * sql/{base-classes,database}.lisp: Add encoding slot for + non-ASCII strings. + * db-mysql/mysql-sql.lisp: Use UFFI:FOREIGN-ENCODED-OCTET-COUNT. + Requires UFFI version 1.8.2 or above. + 2010-02-06 Kevin Rosenberg * Version 5.0.0: First release of CLSQL to formally and consistently support non-ASCII strings with encoding of external diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index 4bf3543..db98e63 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -159,7 +159,8 @@ :mysql-ptr mysql-ptr)) (cmd "SET SESSION sql_mode='ANSI'")) (uffi:with-cstring (cmd-cs cmd) - (if (zerop (mysql-real-query mysql-ptr cmd-cs (uffi:foreign-encoded-string-octets cmd))) + (if (zerop (mysql-real-query mysql-ptr cmd-cs (uffi:foreign-encoded-octet-count + cmd :encoding (encoding db)))) db (progn (warn "Error setting ANSI mode for MySQL.") @@ -177,7 +178,8 @@ (let ((mysql-ptr (database-mysql-ptr database))) (declare (type mysql-mysql-ptr-def mysql-ptr)) (if (zerop (mysql-real-query mysql-ptr sql-native - (uffi:foreign-encoded-string-octets sql-expression))) + (uffi:foreign-encoded-octet-count + sql-expression :encoding (encoding database)))) t (error 'sql-database-data-error :database database @@ -509,7 +511,8 @@ :message (mysql-error-string mysql-ptr))) (uffi:with-cstring (native-query sql-stmt) - (unless (zerop (mysql-stmt-prepare stmt native-query (uffi:foreign-encoded-string-octets sql-stmt))) + (unless (zerop (mysql-stmt-prepare stmt native-query (uffi:foreign-encoded-octet-count + sql-stmt :encoding (encoding database)))) (mysql-stmt-close stmt) (error 'sql-database-error :error-id (mysql-errno mysql-ptr) diff --git a/debian/changelog b/debian/changelog index 758f2ca..ffa633d 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (5.0.1-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Sun, 07 Feb 2010 22:34:13 -0700 + cl-sql (5.0.0-1) unstable; urgency=low * New upstream diff --git a/sql/base-classes.lisp b/sql/base-classes.lisp index 6519f10..344e11c 100644 --- a/sql/base-classes.lisp +++ b/sql/base-classes.lisp @@ -2,8 +2,8 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: classes.lisp -;;;; Purpose: Classes for High-level SQL interface +;;;; Name: base-classes.lisp +;;;; Purpose: Base classes for high-level SQL interface ;;;; Programmers: Kevin M. Rosenberg based on ;;;; original code by Pierre R. Mai ;;;; Date Started: Feb 2002 @@ -23,9 +23,11 @@ ((name :initform nil :initarg :name :reader database-name) (connection-spec :initform nil :initarg :connection-spec :reader connection-spec - :documentation "Require to use connection pool") + :documentation "Required to use connection pool.") (database-type :initarg :database-type :initform :unknown :reader database-type) + (encoding :initarg :encoding :initform nil + :documentation "External format character encoding.") (state :initform :closed :reader database-state) (autocommit :initform t :accessor database-autocommit) (command-recording-stream :accessor command-recording-stream :initform nil) diff --git a/sql/database.lisp b/sql/database.lisp index 41009f5..d4d1d91 100644 --- a/sql/database.lisp +++ b/sql/database.lisp @@ -70,7 +70,8 @@ error is signalled." &key (if-exists *connect-if-exists*) (make-default t) (pool nil) - (database-type *default-database-type*)) + (database-type *default-database-type*) + (encoding nil)) "Connects to a database of the supplied DATABASE-TYPE which defaults to *DEFAULT-DATABASE-TYPE*, using the type-specific connection specification CONNECTION-SPEC. The value of IF-EXISTS, @@ -149,6 +150,7 @@ be taken from this pool." (setf (slot-value result 'state) :open) (pushnew result *connected-databases*) (when make-default (setq *default-database* result)) + (setf (encoding result) encoding) result)))) @@ -307,10 +309,28 @@ system specified by DATABASE-TYPE." (setq connection-spec (string-to-list-connection-spec connection-spec))) (database-list connection-spec database-type)) +(defun encoding (db) + (when (typep db 'database) + (slot-value db 'encoding))) + +(defun (setf encoding) (encoding db) + (when (typep db 'database) + (setf (slot-value db 'encoding) encoding) + (when (eql (slot-value db 'state) :open) + (case database-type + ;; FIXME: If database object is open then + ;; send command to SQL engine specifying the character + ;; encoding for the database + (:mysql + ) + ((:postgresql :postgresql-socket) + ))))) + (defmacro with-database ((db-var connection-spec &key make-default pool (if-exists *connect-if-exists*) - (database-type *default-database-type*)) + (database-type *default-database-type*) + (encoding nil)) &body body) "Evaluate the body in an environment, where DB-VAR is bound to the database connection given by CONNECTION-SPEC and CONNECT-ARGS. The @@ -320,7 +340,8 @@ from the body. MAKE-DEFAULT has a default value of NIL." :database-type ,database-type :if-exists ,if-exists :pool ,pool - :make-default ,make-default))) + :make-default ,make-default + :encoding ,encoding))) (unwind-protect (let ((,db-var ,db-var)) (progn ,@body)) @@ -331,4 +352,3 @@ from the body. MAKE-DEFAULT has a default value of NIL." `(progv '(*default-database*) (list ,database) ,@body)) - diff --git a/sql/package.lisp b/sql/package.lisp index e2e3b70..e8294f7 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -189,6 +189,7 @@ #:database-state #:attribute-cache #:database-autocommit + #:encoding ;; utils.lisp #:without-interrupts -- 2.34.1