Update of /project/pg/cvsroot/pg In directory clnet:/tmp/cvs-serv29766
Modified Files: pg-tests.lisp pg.lisp sysdep.lisp v2-protocol.lisp v3-protocol.lisp Log Message: Allow encoding used for socket communication with the backend to be specified as a keyword argument to PG-CONNECT, for cases where rebinding *PG-CLIENT-ENCODING* is inconvenient.
Add a simple test for encoding support.
(From Attila Lendvai attila.lendvai@gmail.com)
--- /project/pg/cvsroot/pg/pg-tests.lisp 2006/09/24 21:19:30 1.12 +++ /project/pg/cvsroot/pg/pg-tests.lisp 2006/11/19 18:47:58 1.13 @@ -21,16 +21,17 @@ (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) ,@body))) +(defmacro with-test-connection ((conn &key (database "test") + (user-name "pgdotlisp") + (password "secret") + (host "localhost") ;; or "/var/run/postgresql/" + (port 5432) + (encoding *pg-client-encoding*)) + &body body) + `(with-pg-connection (,conn ,database ,user-name :password ,password + :host ,host :port ,port :encoding ,encoding) + ,@body)) +
(defun check-single-return (conn sql expected &key (test #'eql)) (let ((res (pg-exec conn sql))) @@ -40,8 +41,7 @@ (defun test-insert () (format *debug-io* "Testing INSERT & SELECT on integers ...~%") (with-test-connection (conn) - (let ((res nil) - (count 0) + (let ((count 0) (created nil)) (unwind-protect (progn @@ -65,8 +65,7 @@ (defun test-insert/float () (format *debug-io* "Testing INSERT & SELECT on floats ...~%") (with-test-connection (conn) - (let ((res nil) - (sum 0.0) + (let ((sum 0.0) (created nil)) (flet ((float-eql (a b) (< (/ (abs (- a b)) b) 1e-5))) @@ -110,7 +109,7 @@ (pg-for-each conn "SELECT val FROM count_test_numeric" (lambda (tuple) (incf sum (first tuple)))) (assert (eql 500500 sum))) - (check-single-return conn "SELECT 'infinity'::float4 + 'NaN'::float4" 'NAN) + ;; (check-single-return conn "SELECT 'infinity'::float4 + 'NaN'::float4" 'NAN) (check-single-return conn "SELECT 1 / (!! 2)" 1/2) (when created (pg-exec conn "DROP TABLE count_test_numeric")))))) @@ -384,6 +383,20 @@ ;; (format t "stat("/tmp"): ~S~%" (pg-result res :tuples)))))
+(defun test-encoding () + (let ((octets (coerce '(105 97 122 115 124) '(vector (unsigned-byte 8))))) + (dolist (encoding '("UTF8" "LATIN1" "LATIN2")) + (let ((encoded (pg::convert-string-from-bytes octets encoding))) + (with-test-connection (conn :encoding encoding) + (ignore-errors + (pg-exec conn "DROP TABLE encoding_test")) + (pg-exec conn "CREATE TABLE encoding_test (a VARCHAR(40))") + (pg-exec conn "INSERT INTO encoding_test VALUES ('" encoded "')") + (check-single-return conn "SELECT * FROM encoding_test" encoded :test #'string=) + (pg-exec conn "DROP TABLE encoding_test")))))) + + + ;; Fibonnaci numbers with memoization via a database table (defun fib (n) (declare (type integer n)) @@ -532,7 +545,7 @@ (with-test-connection (con) (dotimes (i 5000) (if (= (mod i 1000) 0) (format dio "~s connected over ~S producing ~a~%" - sb-thread:*current-thread* mycony i)) + sb-thread:*current-thread* con i)) (pg-exec con (format nil "INSERT INTO pgmt VALUES (~S, ~D, ~F)" i i i)) (when (zerop (mod i 100)) (pg-exec con "COMMIT WORK"))))) @@ -556,8 +569,7 @@ (with-test-connection (conn) (when (pg-supports-pbe conn) (format *debug-io* "~&Testing PBE/int4 ...") - (let ((res nil) - (count 0) + (let ((count 0) (created nil)) (unwind-protect (progn @@ -574,11 +586,8 @@ (:int32 ,(* i i)))) (pg-execute conn "ct_portal") (pg-close-portal conn "ct_portal")) - (format *debug-io* "~&data inserted") - (setq res (pg-exec conn "SELECT count(val) FROM count_test")) - (assert (eql 100 (first (pg-result res :tuple 0)))) - (setq res (pg-exec conn "SELECT sum(key) FROM count_test")) - (assert (eql 5050 (first (pg-result res :tuple 0)))) + (check-single-return conn "SELECT count(val) FROM count_test" 100) + (check-single-return conn "SELECT sum(key) FROM count_test" 5050) ;; this iterator does the equivalent of the sum(key) SQL statement ;; above, but on the client side. (pg-for-each conn "SELECT key FROM count_test" @@ -591,8 +600,7 @@ (with-test-connection (conn) (when (pg-supports-pbe conn) (format *debug-io* "~&Testing PBE/text...") - (let ((res nil) - (count 0) + (let ((count 0) (created nil)) (unwind-protect (progn @@ -609,11 +617,8 @@ (:string ,(format nil "~a" (* i i))))) (pg-execute conn "ct_portal/text") (pg-close-portal conn "ct_portal/text")) - (format *debug-io* "~&data inserted") - (setq res (pg-exec conn "SELECT count(val) FROM pbe_text_test")) - (assert (eql 100 (first (pg-result res :tuple 0)))) - (setq res (pg-exec conn "SELECT sum(key) FROM pbe_text_test")) - (assert (eql 5050 (first (pg-result res :tuple 0)))) + (check-single-return conn "SELECT count(val) FROM pbe_text_test" 100) + (check-single-return conn "SELECT sum(key) FROM pbe_text_test" 5050) ;; this iterator does the equivalent of the sum(key) SQL statement ;; above, but on the client side. (pg-for-each conn "SELECT key FROM pbe_text_test" --- /project/pg/cvsroot/pg/pg.lisp 2006/09/18 19:10:38 1.9 +++ /project/pg/cvsroot/pg/pg.lisp 2006/11/19 18:47:58 1.10 @@ -1,7 +1,7 @@ ;;; pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp ;; ;; Author: Eric Marsden eric.marsden@free.fr -;; Time-stamp: <2006-09-15 emarsden> +;; Time-stamp: <2006-11-19 emarsden> ;; Version: 0.22 ;; ;; Copyright (C) 1999,2000,2001,2002,2003,2004,2005 Eric Marsden @@ -121,7 +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". + "The encoding that will be used for communication with the PostgreSQL backend, +for example "LATIN1", "UTF8", "EUC_JP". See http://www.postgresql.org/docs/7.3/static/multibyte.html.")
(defvar *pg-date-style* "ISO") @@ -142,7 +143,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,25 +220,28 @@ ;; 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 -connection to the database (as an opaque type). If HOST is nil, attempt -to connect to the database using a Unix socket. -We first attempt to speak the PostgreSQL 7.4 protocol, and fall back to -the older network protocol if necessary." +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 a pathname or a string +starting with #/, it designates the directory containing the Unix +socket on which PostgreSQL's backend is waiting for local connections. +We first attempt to speak the PostgreSQL 7.4 protocol, and fall back +to the older network protocol if necessary." (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) --- /project/pg/cvsroot/pg/sysdep.lisp 2006/10/22 19:22:39 1.18 +++ /project/pg/cvsroot/pg/sysdep.lisp 2006/11/19 18:47:59 1.19 @@ -1,7 +1,7 @@ ;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp ;;; ;;; Author: Eric Marsden eric.marsden@free.fr -;;; Time-stamp: <2006-09-30 emarsden> +;;; Time-stamp: <2006-11-19 emarsden> ;; ;;
@@ -333,6 +333,7 @@ #+(and clisp unicode) (cond ((string-equal encoding "SQL_ASCII") charset:ascii) ((string-equal encoding "LATIN1") charset:iso-8859-1) + ((string-equal encoding "LATIN2") charset:iso-8859-2) ((string-equal encoding "LATIN9") charset:iso-8859-9) ((string-equal encoding "UTF8") charset:utf-8) (t (error "unknown encoding ~A" encoding))) @@ -344,14 +345,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 +370,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) --- /project/pg/cvsroot/pg/v2-protocol.lisp 2005/07/17 15:48:06 1.5 +++ /project/pg/cvsroot/pg/v2-protocol.lisp 2006/11/19 18:47:59 1.6 @@ -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." +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 a pathname or a string whose +first character is #/, it designates the directory containing the +Unix socket on which the PostgreSQL backend is listening." (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) --- /project/pg/cvsroot/pg/v3-protocol.lisp 2006/10/22 19:25:51 1.27 +++ /project/pg/cvsroot/pg/v3-protocol.lisp 2006/11/19 18:47:59 1.28 @@ -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)))) @@ -255,7 +253,8 @@ (cond ((pgcon-encoding connection) (let* ((end (position 0 data :start position)) (result (unless (eql end position) - (convert-string-from-bytes (subseq data position end))))) + (convert-string-from-bytes (subseq data position end) + (pgcon-encoding connection))))) (when result (setf position (1+ end))) result)) ;; the encoding has not yet been set, so revert to :ucstring behaviour @@ -275,13 +274,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 +310,8 @@ ((: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 +354,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 +364,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 +380,15 @@ (%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." +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 a pathname or a string whose +first character is #/, it designates the directory containing the +Unix socket on which the PostgreSQL backend is listening." (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 +442,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 +463,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))
-
emarsden