[pg-devel] Re: one more on board
Attila Lendvai
attila.lendvai at gmail.com
Sat Nov 11 12:44:33 UTC 2006
> i'll keep this mirror in sync and it'll contain our changes. if you
> prefer cvs i'll send the patches as cvs diffs, but i wouldn't mind if
> you copied the already converted darcs repo and use that... (hint hint
> ;)
unfortunately tailor had trouble with the pg repo when converting from
INITIAL to preserve the cvs history (some files were missing from the
result), so the darcs repo starts from the current head unfortunately.
i've pushed a small cleanup that uses *pg-client-encoding* only to
initialize the connection's encoding slot and later on that is used
everywhere. also gave a :encoding keyword param to the connection
creation. this helps in situations where rebinding is not that easy
(when used as a backend plugin in an rdbms abstraction layer).
also added an encoding test with some latin2 chars.
pg is great, small and lightweight, thanks for making it opensource!
--
- attila
"- The truth is that I've been too considerate, and so became
unintentionally cruel...
- I understand.
- No, you don't understand! We don't speak the same language!"
(Ingmar Bergman - Smultronstället)
-------------- next part --------------
Index: pg-tests.lisp
===================================================================
RCS file: /project/pg/cvsroot/pg/pg-tests.lisp,v
retrieving revision 1.12
diff -u -r1.12 pg-tests.lisp
--- pg-tests.lisp 24 Sep 2006 21:19:30 -0000 1.12
+++ pg-tests.lisp 11 Nov 2006 12:36:24 -0000
@@ -21,16 +21,14 @@
(when ,con (pg-disconnect ,con)))))
;; !!! CHANGE THE VALUES HERE !!!
-(defun call-with-test-connection (function)
- (with-pg-connection (conn "test" "pgdotlisp"
- :host "localhost"
- ;; :host "/var/run/postgresql/"
- )
- (funcall function conn)))
-
-(defmacro with-test-connection ((conn) &body body)
- `(call-with-test-connection
- (lambda (,conn) , at body)))
+;; :host "/var/run/postgresql/"
+(defmacro with-test-connection ((conn &key (database "dwim") (user-name "root")
+ (password "admin123") (host "localhost") (port 5432)
+ (encoding *pg-client-encoding*))
+ &body body)
+ `(with-pg-connection (,conn ,database ,user-name :password ,password
+ :host ,host :port ,port :encoding ,encoding)
+ , at body))
(defun check-single-return (conn sql expected &key (test #'eql))
(let ((res (pg-exec conn sql)))
@@ -670,6 +668,20 @@
(pg-exec conn "INSERT INTO pg_trigger_table VALUES (3, 4)")
(pg-exec conn "DROP TABLE pg_trigger_table")))
+;; assumes that the lisp source file is processed as utf-8
+(defun test-encoding ()
+ (let ((value "��������������") ; some chars in the :iso-8859-2 encoding
+ (result))
+ (with-test-connection (conn :encoding "UTF8") ; LATIN2 is the hungarian encoding, that should work, too
+ (ignore-errors
+ (pg-exec conn "DROP TABLE encoding_test"))
+ (pg-exec conn "CREATE TABLE encoding_test (a varchar(40))")
+ (pg-exec conn (concatenate 'string "INSERT INTO encoding_test VALUES ('" value "')"))
+ (setf result (first (first (pg-result (pg-exec conn "SELECT * FROM encoding_test")
+ :tuples))))
+ (assert (string= result value))
+ (pg-exec conn "DROP TABLE encoding_test")
+ result)))
(defun test ()
(let (#+nil(*pg-client-encoding* "UTF8"))
@@ -703,6 +715,7 @@
(test-notifications)
(test-lo)
(test-lo-read)
+ (test-encoding)
#+cmu (test-lo-import)
(test-pbe)
(test-pbe-text)
Index: pg.lisp
===================================================================
RCS file: /project/pg/cvsroot/pg/pg.lisp,v
retrieving revision 1.9
diff -u -r1.9 pg.lisp
--- pg.lisp 18 Sep 2006 19:10:38 -0000 1.9
+++ pg.lisp 11 Nov 2006 12:36:24 -0000
@@ -121,8 +121,8 @@
(defconstant +MAX_MESSAGE_LEN+ 8192) ; libpq-fe.h
(defvar *pg-client-encoding* "LATIN1"
- "The encoding to use for text data, for example \"LATIN1\", \"UTF8\", \"EUC_JP\".
-See <http://www.postgresql.org/docs/7.3/static/multibyte.html>.")
+ "The encoding that will be used on the socket while comminucating with the server.
+(\"LATIN1\", \"UTF8\", \"EUC_JP\", etc). See <http://www.postgresql.org/docs/7.3/static/multibyte.html>.")
(defvar *pg-date-style* "ISO")
@@ -142,7 +142,9 @@
(notices :accessor pgcon-notices
:initform (list))
(binary-p :accessor pgcon-binary-p
- :initform nil)))
+ :initform nil)
+ (encoding :accessor pgcon-encoding
+ :initarg :encoding)))
(defmethod print-object ((self pgcon) stream)
(print-unreadable-object (self stream :type nil)
@@ -217,7 +219,8 @@
;; the v2 protocol. This allows us to connect to PostgreSQL 7.4
;; servers using the benefits of the new protocol, but still interact
;; with older servers.
-(defun pg-connect (dbname user &key (host "localhost") (port 5432) (password ""))
+(defun pg-connect (dbname user &key (host "localhost") (port 5432) (password "")
+ (encoding *pg-client-encoding*))
"Initiate a connection with the PostgreSQL backend.
Connect to the database DBNAME with the username USER,
on PORT of HOST, providing PASSWORD if necessary. Return a
@@ -228,14 +231,16 @@
(handler-case (pg-connect/v3 dbname user
:host host
:port port
- :password password)
+ :password password
+ :encoding encoding)
(protocol-error (c)
(declare (ignore c))
(warn "reconnecting using protocol version 2")
(pg-connect/v2 dbname user
:host host
:port port
- :password password))))
+ :password password
+ :encoding encoding))))
(defun pg-result (result what &rest args)
Index: sysdep.lisp
===================================================================
RCS file: /project/pg/cvsroot/pg/sysdep.lisp,v
retrieving revision 1.18
diff -u -r1.18 sysdep.lisp
--- sysdep.lisp 22 Oct 2006 19:22:39 -0000 1.18
+++ sysdep.lisp 11 Nov 2006 12:36:24 -0000
@@ -344,14 +344,15 @@
(t (error "unknown encoding ~A" encoding)))
#+(and sbcl sb-unicode)
(cond ((string-equal encoding "SQL_ASCII") :ascii)
- ((string-equal encoding "LATIN1") :latin1)
- ((string-equal encoding "LATIN9") :latin9)
+ ((string-equal encoding "LATIN1") :iso-8859-1)
+ ((string-equal encoding "LATIN2") :iso-8859-2)
+ ((string-equal encoding "LATIN9") :iso-8859-9)
((string-equal encoding "UTF8") :utf8)
(t (error "unknown encoding ~A" encoding)))
#+(or cmu gcl ecl abcl openmcl lispworks)
nil))
-(defun convert-string-to-bytes (string &optional (encoding *pg-client-encoding*))
+(defun convert-string-to-bytes (string encoding)
(declare (type string string))
(%sysdep "convert string to octet-array"
#+(and clisp unicode)
@@ -368,7 +369,7 @@
(map-into octets #'char-code string))
(error "Can't convert ~A string to octets" encoding))))
-(defun convert-string-from-bytes (bytes &optional (encoding *pg-client-encoding*))
+(defun convert-string-from-bytes (bytes encoding)
(declare (type (vector (unsigned-byte 8)) bytes))
(%sysdep "convert octet-array to string"
#+(and clisp unicode)
Index: v2-protocol.lisp
===================================================================
RCS file: /project/pg/cvsroot/pg/v2-protocol.lisp,v
retrieving revision 1.5
diff -u -r1.5 v2-protocol.lisp
--- v2-protocol.lisp 17 Jul 2005 15:48:06 -0000 1.5
+++ v2-protocol.lisp 11 Nov 2006 12:36:25 -0000
@@ -10,14 +10,15 @@
-(defun pg-connect/v2 (dbname user &key (host "localhost") (port 5432) (password ""))
+(defun pg-connect/v2 (dbname user &key (host "localhost") (port 5432) (password "")
+ (encoding *pg-client-encoding*))
"Initiate a connection with the PostgreSQL backend, using protocol v2.
Connect to the database DBNAME with the username USER,
on PORT of HOST, providing PASSWORD if necessary. Return a
connection to the database (as an opaque type). If HOST is nil, attempt
to connect to the database using a Unix socket."
(let* ((stream (socket-connect port host))
- (connection (make-instance 'pgcon-v2 :stream stream :host host :port port))
+ (connection (make-instance 'pgcon-v2 :stream stream :host host :port port :encoding encoding))
(user-packet-length (+ +SM_USER+ +SM_OPTIONS+ +SM_UNUSED+ +SM_TTY+)))
;; send the startup packet
(send-int connection +STARTUP_PACKET_SIZE+ 4)
@@ -43,8 +44,8 @@
(initialize-parsers connection))
(when *pg-date-style*
(setf (pg-date-style connection) *pg-date-style*))
- (when *pg-client-encoding*
- (setf (pg-client-encoding connection) *pg-client-encoding*))
+ (when encoding
+ (setf (pg-client-encoding connection) encoding))
(return connection))
((3) ; AuthUnencryptedPassword
(send-int connection (+ 5 (length password)) 4)
Index: v3-protocol.lisp
===================================================================
RCS file: /project/pg/cvsroot/pg/v3-protocol.lisp,v
retrieving revision 1.27
diff -u -r1.27 v3-protocol.lisp
--- v3-protocol.lisp 22 Oct 2006 19:25:51 -0000 1.27
+++ v3-protocol.lisp 11 Nov 2006 12:36:25 -0000
@@ -12,8 +12,6 @@
(defclass pgcon-v3 (pgcon)
((parameters :accessor pgcon-parameters
:initform (list))
- (encoding :accessor pgcon-encoding
- :initform nil)
(sql-stream :initform nil
:accessor pgcon-sql-stream
:type (or null stream))))
@@ -252,15 +250,12 @@
;; its prefered encoding
(:method ((packet pg-packet) (type (eql :cstring)))
(with-slots (data position connection) packet
- (cond ((pgcon-encoding connection)
- (let* ((end (position 0 data :start position))
- (result (unless (eql end position)
- (convert-string-from-bytes (subseq data position end)))))
- (when result (setf position (1+ end)))
- result))
- ;; the encoding has not yet been set, so revert to :ucstring behaviour
- (t
- (read-from-packet packet :ucstring))))))
+ (let* ((end (position 0 data :start position))
+ (result (unless (eql end position)
+ (convert-string-from-bytes (subseq data position end)
+ (pgcon-encoding connection)))))
+ (when result (setf position (1+ end)))
+ result))))
;; FIXME need to check all callers of this function to distinguish
@@ -275,13 +270,14 @@
(when (< length 0)
(error "length cannot be negative. is: ~S"
length))
- (let* ((octets (read-octets-from-packet packet length))
- (encoding (if (or (eql #\R (pg-packet-type packet))
- (eql #\E (pg-packet-type packet)))
- "LATIN1"
- *pg-client-encoding*))
- (string (convert-string-from-bytes octets encoding)))
- string)))
+ (with-slots (connection) packet
+ (let* ((octets (read-octets-from-packet packet length))
+ (encoding (if (or (eql #\R (pg-packet-type packet))
+ (eql #\E (pg-packet-type packet)))
+ "LATIN1"
+ (pgcon-encoding connection)))
+ (string (convert-string-from-bytes octets encoding)))
+ string))))
(defgeneric read-octets-from-packet (packet length))
@@ -310,8 +306,10 @@
((:int16) 2)
((:int32) 4)
((:rawdata) (length value))
- ((:string) (length (convert-string-to-bytes value)))
- ((:cstring) (1+ (length (convert-string-to-bytes value))))
+ ((:string) (length (convert-string-to-bytes
+ value (pgcon-encoding connection))))
+ ((:cstring) (1+ (length (convert-string-to-bytes
+ value (pgcon-encoding connection)))))
((:ucstring) (1+ (length value)))))))
(data (make-array (- length 4)
:element-type '(unsigned-byte 8)))
@@ -354,7 +352,7 @@
((:cstring)
(check-type value string)
- (let ((encoded (convert-string-to-bytes value)))
+ (let ((encoded (convert-string-to-bytes value (pgcon-encoding connection))))
(declare (type (vector (unsigned-byte 8) *) encoded))
(replace data encoded :start1 position)
(incf position (length encoded)))
@@ -364,7 +362,7 @@
;; a string without the trailing NUL character
((:string)
(check-type value string)
- (let ((encoded (convert-string-to-bytes value)))
+ (let ((encoded (convert-string-to-bytes value (pgcon-encoding connection))))
(declare (type (vector (unsigned-byte 8) *) encoded))
(replace data encoded :start1 position)
(incf position (length encoded))))
@@ -380,14 +378,14 @@
(%flush connection)))
-(defun pg-connect/v3 (dbname user &key (host "localhost") (port 5432) (password ""))
+(defun pg-connect/v3 (dbname user &key (host "localhost") (port 5432) (password "") (encoding *pg-client-encoding*))
"Initiate a connection with the PostgreSQL backend.
Connect to the database DBNAME with the username USER,
on PORT of HOST, providing PASSWORD if necessary. Return a
connection to the database (as an opaque type). If HOST is nil, attempt
to connect to the database using a Unix socket."
(let* ((stream (socket-connect port host))
- (connection (make-instance 'pgcon-v3 :stream stream :host host :port port))
+ (connection (make-instance 'pgcon-v3 :stream stream :host host :port port :encoding encoding))
(connect-options `("user" ,user
"database" ,dbname))
(user-packet-length (+ 4 4 (loop :for item :in connect-options :sum (1+ (length item))) 1)))
@@ -441,7 +439,7 @@
(t (error 'authentication-failure
:reason "unknown authentication type")))))
- (( #\K)
+ ((#\K)
;; Cancelation
(let* ((pid (read-from-packet packet :int32))
(secret (read-from-packet packet :int32)))
@@ -462,8 +460,8 @@
(let* ((status (read-from-packet packet :byte)))
(unless (= status (char-code #\I))
(warn "~&Got status ~S but wanted I~%" (code-char status)))
- (when *pg-client-encoding*
- (setf (pg-client-encoding connection) *pg-client-encoding*))
+ (when encoding
+ (setf (pg-client-encoding connection) encoding))
(and (not *pg-disable-type-coercion*)
(null *parsers*)
(initialize-parsers connection))
More information about the pg-devel
mailing list