[pg-cvs] CVS pg
emarsden
emarsden at common-lisp.net
Sun Nov 19 18:47:59 UTC 2006
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 at 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) , at 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)
+ , at 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 at 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 at 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))
More information about the Pg-cvs
mailing list