Commit ab33c1b9 authored by Eric Marsden's avatar Eric Marsden

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>)
parent baed7a3f
......@@ -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 &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))
(defmacro with-test-connection ((conn) &body body)
`(call-with-test-connection
(lambda (,conn) ,@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 @@ between files /etc/group and /tmp/group")))
(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 @@ between files /etc/group and /tmp/group")))
(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 @@ between files /etc/group and /tmp/group")))
(: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 @@ between files /etc/group and /tmp/group")))
(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 @@ between files /etc/group and /tmp/group")))
(: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"
......
;;; 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 @@ Is the postmaster running and accepting TCP connections?~%"
(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 @@ See <http://www.postgresql.org/docs/7.3/static/multibyte.html>.")
(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 @@ all portals associated with that statement (see PG-PREPARE and PG-BIND)."))
;; 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)
......
;;; 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)
......
......@@ -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 @@ to connect to the database using a Unix socket."
(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)
......
......@@ -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 @@ but will still return them"
(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 @@ but will still return them"
(when (< length 0)
(error "length cannot be negative. is: ~S"
length))
(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"
*pg-client-encoding*))
(pgcon-encoding connection)))
(string (convert-string-from-bytes octets encoding)))
string)))
string))))
(defgeneric read-octets-from-packet (packet length))
......@@ -310,8 +310,8 @@ value of the parameter"
((: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 @@ value of the parameter"
((: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 @@ value of the parameter"
;; 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 @@ value of the parameter"
(%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 @@ to connect to the database using a Unix socket."
(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 @@ to connect to the database using a Unix socket."
(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))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment