- pg-cvs@common-lisp.net - mailman3.common-lisp.net

[pg-cvs] CVS update: pg/sysdep.lisp
by emarsden＠common-lisp.net 19 Dec '05

19 Dec '05

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv4467 Modified Files: sysdep.lisp Log Message: Fix sockets for recent ABCL versions. Modify the client-encoding code to work with multiple implementations (incomplete testing). Date: Mon Dec 19 23:18:37 2005 Author: emarsden Index: pg/sysdep.lisp diff -u pg/sysdep.lisp:1.10 pg/sysdep.lisp:1.11 --- pg/sysdep.lisp:1.10 Tue Oct 18 15:07:27 2005 +++ pg/sysdep.lisp Mon Dec 19 23:18:32 2005 @@ -1,12 +1,17 @@ ;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp ;;; ;;; Author: Eric Marsden <eric.marsden(a)free.fr> -;;; Time-stamp: <2005-07-17 emarsden> +;;; Time-stamp: <2005-12-09 emarsden> ;; ;; (in-package :postgresql) +#+allegro (require :socket) +#+lispworks (require "comm") +#+cormanlisp (require :sockets) +#+armedbear (require :socket) + (defmacro %sysdep (desc &rest forms) (when (null forms) @@ -278,14 +283,14 @@ #+armedbear (eval-when (:load-toplevel :execute :compile-toplevel) - (require 'format)) + (require :socket)) -;; MAKE-SOCKET with :element-type as per 2004-03-09 #+armedbear (defun socket-connect (port host) (declare (type integer port)) - (handler-case - (ext:make-socket host port :element-type '(unsigned-byte 8)) + (handler-case + (ext:get-socket-stream (ext:make-socket host port) + :element-type '(unsigned-byte 8)) (error (e) (error 'connection-failure :host host @@ -293,48 +298,84 @@ :transport-error e)))) +;; for Lispworks +;; (defun encode-lisp-string (string) +;; (translate-string-via-fli string :utf-8 :latin-1)) +;; +;; (defun decode-external-string (string) +;; (translate-string-via-fli string :latin-1 :utf-8)) +;; +;; ;; Note that a :utf-8 encoding of a null in a latin-1 string is +;; ;; also null, and vice versa. So don't have to worry about +;; ;; null-termination or length. (If we were translating to/from +;; ;; :unicode, this would become an issue.) +;; +;; (defun translate-string-via-fli (string from to) +;; (fli:with-foreign-string (ptr elements bytes :external-format from) +;; string +;; (declare (ignore elements bytes)) +;; (fli:convert-from-foreign-string ptr :external-format to))) + ;;; character encoding support (defvar *pg-client-encoding*) -#+(and :sbcl :sb-unicode) -(defun sbcl-ext-form-from-client-encoding (encoding) - (cond - ((string= encoding "SQL_ASCII") :ascii) - ((string= encoding "LATIN1") :latin1) - ((string= encoding "LATIN9") :latin9) - ((string= encoding "UNICODE") :utf8) - (t (error "unkown encoding ~A" encoding)))) - +(defun implementation-name-for-encoding (encoding) + (%sysdep "client encoding to external format name" + #+(and clisp unicode) + (cond ((string= encoding "SQL_ASCII") :ascii) + ((string= encoding "LATIN1") :latin1) + ((string= encoding "LATIN9") :latin9) + ((string= encoding "UNICODE") :utf8) + (t (error "unknown encoding ~A" encoding))) + #+(and allegro ics) + (cond ((string= encoding "SQL_ASCII") :ascii) + ((string= encoding "LATIN1") :latin1) + ((string= encoding "LATIN9") :latin9) + ((string= encoding "UNICODE") :utf8) + (t (error "unknown encoding ~A" encoding))) + #+(and sbcl sb-unicode) + (cond ((string= encoding "SQL_ASCII") :ascii) + ((string= encoding "LATIN1") :latin1) + ((string= encoding "LATIN9") :latin9) + ((string= encoding "UNICODE") :utf8) + (t (error "unknown encoding ~A" encoding))) + #+(or cmu gcl ecl abcl) + (cond ((string= encoding "SQL_ASCII") :ascii) + ((string= encoding "LATIN1") :latin1) + ((string= encoding "LATIN9") :latin9)))) + (defun convert-string-to-bytes (string &optional (encoding *pg-client-encoding*)) (declare (type string string)) (%sysdep "convert string to bytes" #+(and clisp unicode) - (ext:convert-string-to-bytes string encoding) + (ext:convert-string-to-bytes string (implementation-name-for-encoding encoding)) #+(and allegro ics) (excl:string-to-octets string :null-terminate nil - :external-format encoding) + :external-format (implementation-name-for-encoding encoding)) #+(and :sbcl :sb-unicode) - (sb-ext:string-to-octets string :external-format (sbcl-ext-form-from-client-encoding encoding)) - #+(or cmu sbcl gcl ecl) - (let ((octets (make-array (length string) :element-type '(unsigned-byte 8)))) - (map-into octets #'char-code string)))) + (sb-ext:string-to-octets string + :external-format (implementation-name-for-encoding encoding)) + #+(or cmu gcl ecl abcl) + (if (member encoding '("SQL_ASCII" "LATIN1" "LATIN9") :test #'string-equal) + (let ((octets (make-array (length string) :element-type '(unsigned-byte 8)))) + (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*)) (declare (type (vector (unsigned-byte 8)) bytes)) (%sysdep "convert octet-array to string" #+(and clisp unicode) - (ext:convert-string-from-bytes bytes encoding) + (ext:convert-string-from-bytes bytes (implementation-name-for-encoding encoding)) #+(and allegro ics) - (excl:octets-to-string bytes :external-format encoding) + (excl:octets-to-string bytes :external-format (implementation-name-for-encoding encoding)) #+(and :sbcl :sb-unicode) - (sb-ext:octets-to-string bytes :external-format - (sbcl-ext-form-from-client-encoding encoding)) + (sb-ext:octets-to-string bytes :external-format (implementation-name-for-encoding encoding)) ;; for implementations that have no support for character ;; encoding, we assume that the encoding is an octet-for-octet ;; encoding, and convert directly - #+(or cmu (and sbcl (not :sb-unicode)) gcl ecl) + #+(or cmu (and sbcl (not :sb-unicode)) gcl ecl abcl) (let ((string (make-string (length bytes)))) (map-into string #'code-char bytes))))

1 0

[pg-cvs] CVS update: pg/meta-queries.lisp
by emarsden＠common-lisp.net 19 Dec '05

19 Dec '05

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv4439 Modified Files: meta-queries.lisp Log Message: Add a utility function PG-DESCRIBE-TABLE. Date: Mon Dec 19 23:16:43 2005 Author: emarsden Index: pg/meta-queries.lisp diff -u pg/meta-queries.lisp:1.1 pg/meta-queries.lisp:1.2 --- pg/meta-queries.lisp:1.1 Fri Mar 5 19:08:08 2004 +++ pg/meta-queries.lisp Mon Dec 19 23:16:42 2005 @@ -1,7 +1,7 @@ ;;; meta-queries.lisp -- DBMS metainformation ;;; -;;; Author: Eric Marsden <emarsden(a)laas.fr> -;;; Time-stamp: <2004-03-05 emarsden> +;;; Author: Eric Marsden <eric.marsden(a)free.fr> +;;; Time-stamp: <2005-12-19 emarsden> ;; ;; ;; Metainformation such as the list of databases present in the @@ -35,6 +35,16 @@ "Return a string identifying the version and operating environment of the backend." (let ((res (pg-exec conn "SELECT version()"))) (first (pg-result res :tuple 0)))) + +(defun pg-describe-table (conn table) + (flet ((oid-to-name (oid) + (maphash (lambda (key value) + (when (eql value oid) + (return-from oid-to-name key))) + *type-to-oid*))) + (let ((res (pg-exec conn (format nil "SELECT * FROM ~S WHERE 0=1" table)))) + (loop :for (name oid) :in (pg-result res :attributes) + :collect (list name (oid-to-name oid)))))) ;; EOF

1 0

[pg-cvs] CVS update: pg/debian/changelog
by pvaneynde＠common-lisp.net 18 Oct '05

18 Oct '05

Update of /project/pg/cvsroot/pg/debian In directory common-lisp.net:/tmp/cvs-serv17791/debian Modified Files: changelog Log Message: Modified sbcl unicode support, works for me. Moved requires into asdf package, otherwise we get asdf package problems, unknown if it works with other lisps Date: Tue Oct 18 15:07:28 2005 Author: pvaneynde Index: pg/debian/changelog diff -u pg/debian/changelog:1.6 pg/debian/changelog:1.7 --- pg/debian/changelog:1.6 Mon Aug 1 11:15:12 2005 +++ pg/debian/changelog Tue Oct 18 15:07:28 2005 @@ -1,3 +1,11 @@ +cl-pg (20050717-2) UNRELEASED; urgency=low + + * token new version + * Better sbcl unicode support + * Improved asdf compatibility + + -- Peter Van Eynde <pvaneynd(a)debian.org> Tue, 18 Oct 2005 14:52:23 +0200 + cl-pg (20050717-1) unstable; urgency=low * token new darcs version

1 0

[pg-cvs] CVS update: pg/pg.asd pg/sysdep.lisp pg/v3-protocol.lisp
by pvaneynde＠common-lisp.net 18 Oct '05

18 Oct '05

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv17791 Modified Files: pg.asd sysdep.lisp v3-protocol.lisp Log Message: Modified sbcl unicode support, works for me. Moved requires into asdf package, otherwise we get asdf package problems, unknown if it works with other lisps Date: Tue Oct 18 15:07:27 2005 Author: pvaneynde Index: pg/pg.asd diff -u pg/pg.asd:1.7 pg/pg.asd:1.8 --- pg/pg.asd:1.7 Sun Jul 17 17:44:48 2005 +++ pg/pg.asd Tue Oct 18 15:07:27 2005 @@ -16,6 +16,12 @@ :name "Socket-level PostgreSQL interface" :author "Eric Marsden" :version "0.22" + :depends-on ( + #+allegro :socket + #+lispworks "comm" + #+cormanlisp :sockets + #+sbcl :sb-bsd-sockets + #+(and mcl (not openmcl)) "OPENTRANSPORT") :components ((:file "md5") (:file "defpackage" :depends-on ("md5")) (:pg-component "sysdep" :depends-on ("defpackage" "md5")) Index: pg/sysdep.lisp diff -u pg/sysdep.lisp:1.9 pg/sysdep.lisp:1.10 --- pg/sysdep.lisp:1.9 Sun Jul 17 17:46:32 2005 +++ pg/sysdep.lisp Tue Oct 18 15:07:27 2005 @@ -7,13 +7,6 @@ (in-package :postgresql) -(eval-when (:compile-toplevel :load-toplevel :execute) - #+allegro (require :socket) - #+lispworks (require "comm") - #+cormanlisp (require :sockets) - #+sbcl (require :sb-bsd-sockets) - #+(and mcl (not openmcl)) (require "OPENTRANSPORT")) - (defmacro %sysdep (desc &rest forms) (when (null forms) @@ -336,7 +329,8 @@ #+(and allegro ics) (excl:octets-to-string bytes :external-format encoding) #+(and :sbcl :sb-unicode) - (sb-ext:octets-to-string bytes :external-format encoding) + (sb-ext:octets-to-string bytes :external-format + (sbcl-ext-form-from-client-encoding encoding)) ;; for implementations that have no support for character ;; encoding, we assume that the encoding is an octet-for-octet ;; encoding, and convert directly Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.17 pg/v3-protocol.lisp:1.18 --- pg/v3-protocol.lisp:1.17 Sun Jul 17 17:48:06 2005 +++ pg/v3-protocol.lisp Tue Oct 18 15:07:27 2005 @@ -274,18 +274,10 @@ (when (< length 0) (error "length cannot be negative. is: ~S" length)) - (let ((result (make-array length - :element-type 'base-char))) - (with-slots (data position) - packet - (loop :for i :from 0 :below length - :do - (setf (elt result i) - (code-char - (the (unsigned-byte 8) - (elt data (+ i position)))))) - (incf position length) - result)))) + (let* ((octects (read-octets-from-packet packet + length)) + (string (convert-string-from-bytes octects))) + string))) (defmethod read-octets-from-packet ((packet pg-packet) (length integer)) (let ((result (make-array length :element-type '(unsigned-byte 8))))

1 0

[pg-cvs] CVS update: pg/debian/changelog pg/debian/control pg/debian/rules
by pvaneynde＠common-lisp.net 01 Aug '05

01 Aug '05

Update of /project/pg/cvsroot/pg/debian In directory common-lisp.net:/tmp/cvs-serv23827/debian Modified Files: changelog control rules Log Message: new debian package Date: Mon Aug 1 11:15:13 2005 Author: pvaneynde Index: pg/debian/changelog diff -u pg/debian/changelog:1.5 pg/debian/changelog:1.6 --- pg/debian/changelog:1.5 Mon Sep 20 00:14:13 2004 +++ pg/debian/changelog Mon Aug 1 11:15:12 2005 @@ -1,3 +1,12 @@ +cl-pg (20050717-1) unstable; urgency=low + + * token new darcs version + * unicode fix + * New upstream. + * Now no longer a native package to ease NMU and ubuntu related forks. + + -- Peter Van Eynde <pvaneynd(a)debian.org> Mon, 1 Aug 2005 11:12:33 +0200 + cl-pg (20040920) unstable; urgency=low * New upstream release: Index: pg/debian/control diff -u pg/debian/control:1.1 pg/debian/control:1.2 --- pg/debian/control:1.1 Tue Mar 9 17:25:27 2004 +++ pg/debian/control Mon Aug 1 11:15:12 2005 @@ -3,7 +3,7 @@ Priority: optional Maintainer: Peter Van Eynde <pvaneynd(a)debian.org> Build-Depends-Indep: debhelper (>> 3.0.0) -Standards-Version: 3.6.1 +Standards-Version: 3.6.2.1 Package: cl-pg Architecture: all Index: pg/debian/rules diff -u pg/debian/rules:1.2 pg/debian/rules:1.3 --- pg/debian/rules:1.2 Tue Aug 10 13:00:32 2004 +++ pg/debian/rules Mon Aug 1 11:15:12 2005 @@ -82,7 +82,7 @@ dh_installman dh_installinfo # dh_undocumented - dh_installchangelogs NEWS + dh_installchangelogs NEWS ChangeLog dh_link dh_strip dh_compress

1 0

[pg-cvs] CVS update: pg/README
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv9050 Modified Files: README Log Message: Note that the current code has been tested against PostgreSQL 8.0 (with both v2 and v3 protocol versions). Date: Sun Jul 17 17:49:15 2005 Author: emarsden Index: pg/README diff -u pg/README:1.3 pg/README:1.4 --- pg/README:1.3 Thu Apr 1 20:35:19 2004 +++ pg/README Sun Jul 17 17:49:14 2005 @@ -1,7 +1,7 @@ pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp - Author: Eric Marsden <emarsden(a)laas.fr> - Time-stamp: <2004-04-01 emarsden> + Author: Eric Marsden <eric.marsden(a)free.fr> + Time-stamp: <2005-07-17 emarsden> Version: 0.22 Copyright (C) 1999,2000,2001,2002,2003,2004 Eric Marsden @@ -246,13 +246,14 @@ This code has been tested or reported to work with - * CMUCL 18d and 18e on Solaris/SPARC and Linux/x86 + * CMUCL 18d, 18e, 19a on Solaris/SPARC and Linux/x86 + * SBCL 0.9.2 on Linux/x86 * CLISP 2.30 on LinuxPPC and SPARC * OpenMCL 0.13.x and 0.14.x on LinuxPPC * Armed Bear Common Lisp * ACL 6.1 trial/x86 * Lispworks 4.3 on Linux and Windows - * PostgreSQL versions 6.5, 7.0, 7.1.2, 7.2, 7.3, 7.4 + * PostgreSQL versions 6.5, 7.0, 7.1.2, 7.2, 7.3, 7.4, 8.0 You may be interested in using "pg-psql" by Harley Gorrell, which

1 0

[pg-cvs] CVS update: pg/large-object.lisp pg/v2-protocol.lisp pg/v3-protocol.lisp pg/lowlevel.lisp pg/pg.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv9011 Modified Files: large-object.lisp v2-protocol.lisp v3-protocol.lisp lowlevel.lisp pg.lisp Log Message: Make PGLO-READ a generic function, with specializations on the v2 and v3 protocols. The difference is necessary because the v2 protocol reads large-object data in text, whereas the v3 protocol changed to use a binary format. Date: Sun Jul 17 17:48:06 2005 Author: emarsden Index: pg/large-object.lisp diff -u pg/large-object.lisp:1.2 pg/large-object.lisp:1.3 --- pg/large-object.lisp:1.2 Fri Aug 13 18:50:37 2004 +++ pg/large-object.lisp Sun Jul 17 17:48:06 2005 @@ -1,6 +1,6 @@ ;;; large-object.lisp -- support for BLOBs ;;; -;;; Author: Eric Marsden <emarsden(a)laas.fr> +;;; Author: Eric Marsden <eric.marsden(a)free.fr> ;; ;; ;; Sir Humphrey: Who is Large and to what does he object? @@ -81,10 +81,10 @@ (defun pglo-close (connection fd) (fn connection "lo_close" t fd)) -;; note that the 3rd argument means that we are reading data in binary -;; format, not text -(defun pglo-read (connection fd bytes) - (fn connection "loread" t fd bytes)) +;; pglo-read has moved to v2-protocol.lisp and v3-protocol.lisp +;; +;; the difference between the v3 and v2 protocols is that in the former case +;; data is read in binary format, whereas in the latter data is read as text. (defun pglo-write (connection fd buf) (fn connection "lowrite" t fd buf)) Index: pg/v2-protocol.lisp diff -u pg/v2-protocol.lisp:1.4 pg/v2-protocol.lisp:1.5 --- pg/v2-protocol.lisp:1.4 Thu Apr 1 20:35:19 2004 +++ pg/v2-protocol.lisp Sun Jul 17 17:48:06 2005 @@ -1,6 +1,6 @@ ;;; v2-protocol.lisp -- frontend/backend protocol prior to PostgreSQL 7.4 ;;; -;;; Author: Eric Marsden <emarsden(a)laas.fr> +;;; Author: Eric Marsden <eric.marsden(a)free.fr> (in-package :postgresql) @@ -197,6 +197,9 @@ ((stringp arg) (send-int connection (length arg) 4) (send-string connection arg)) + ((vectorp arg) + (send-int connection (length arg) 4) + (send-octets connection arg)) (t (error 'protocol-error :reason (format nil "Unknown fastpath type ~s" arg))))) (%flush connection) @@ -293,6 +296,12 @@ (defun handle-notice (connection) (push (%read-cstring (pgcon-stream connection) +MAX_MESSAGE_LEN+) (pgcon-notices connection))) + + +;; split out from large-object.lisp +(defmethod pglo-read ((connection pgcon-v2) fd bytes) + (let ((octets (fn connection "loread" nil fd bytes))) + (map '(vector (unsigned-byte 8)) #'char-code octets))) ;; EOF Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.16 pg/v3-protocol.lisp:1.17 --- pg/v3-protocol.lisp:1.16 Sun Jul 17 15:46:50 2005 +++ pg/v3-protocol.lisp Sun Jul 17 17:48:06 2005 @@ -965,4 +965,11 @@ (defmethod pg-close-portal ((connection pgcon-v3) (portal string)) (pg-close connection portal #\P)) + +;; split out from large-object.lisp +(defmethod pglo-read ((connection pgcon-v3) fd bytes) + (fn connection "loread" t fd bytes)) + + + ;; EOF Index: pg/lowlevel.lisp diff -u pg/lowlevel.lisp:1.3 pg/lowlevel.lisp:1.4 --- pg/lowlevel.lisp:1.3 Mon Mar 8 19:12:45 2004 +++ pg/lowlevel.lisp Sun Jul 17 17:48:06 2005 @@ -1,7 +1,7 @@ ;;; lowlevel.lisp -- lowlevel network ;;; ;;; Author: Eric Marsden <emarsden> -;;; Time-stamp: <2004-03-08 emarsden> +;;; Time-stamp: <2005-07-17 emarsden> (in-package :postgresql) @@ -117,6 +117,10 @@ :initial-element 0 :element-type '(unsigned-byte 8)) stream)))) + +(defun send-octets (connection buffer) + (declare (type (vector (unsigned-byte 8) *) buffer)) + (write-sequence buffer (pgcon-stream connection))) ;; highest order bits first (defun send-int (connection int bytes) Index: pg/pg.lisp diff -u pg/pg.lisp:1.4 pg/pg.lisp:1.5 --- pg/pg.lisp:1.4 Mon Mar 8 16:01:53 2004 +++ pg/pg.lisp Sun Jul 17 17:48:06 2005 @@ -1,10 +1,10 @@ ;;; pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp ;; -;; Author: Eric Marsden <emarsden(a)laas.fr> -;; Time-stamp: <2004-03-08 emarsden> -;; Version: 0.21 +;; Author: Eric Marsden <eric.marsden(a)free.fr> +;; Time-stamp: <2005-07-17 emarsden> +;; Version: 0.22 ;; -;; Copyright (C) 1999,2000,2001,2002,2003 Eric Marsden +;; Copyright (C) 1999,2000,2001,2002,2003,2004,2005 Eric Marsden ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Library General Public @@ -20,10 +20,7 @@ ;; License along with this library; if not, write to the Free ;; Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;; -;; Please send suggestions and bug reports to <emarsden(a)laas.fr> -;; The latest version of this package should be available from -;; -;; <URL:http://purl.org/net/emarsden/home/downloads/> +;; Please send suggestions and bug reports to <eric.marsden(a)free.fr> ;;; Overview ========================================================= @@ -42,27 +39,13 @@ ;; ;; See the README for API documentation. -;; This code has been tested or reported to work with -;; -;; * CMUCL 18d and 18e on Solaris/SPARC and Linux/x86 -;; * SBCL 0.8 on Linux/x86 and Linux/PowerPC -;; * CLISP 2.31 on Linux/PowerPC, Solaris and Linux/x86 -;; * OpenMCL 0.13.6 on Linux/PowerPC and MacOS 10.2 -;; * Armed Bear Lisp version 0.20 -;; * Lispworks 4.3 personal edition for MacOS X and win32 -;; * Allegro CL 6.1 trial Linux/x86 -;; * ECL as of 2003-10-10 -;; * PostgreSQL 6.5, 7.0, 7.1.2, 7.2, 7.3 (and equivalent "Red Hat -;; Database" versions) -;; -;; ;; Please note that your postmaster has to be started with the `-i' ;; option in order for it to accept TCP/IP connections (typically this ;; is not the default setting). See the PostgreSQL documentation at ;; <URL:http://www.PostgreSQL.org/> for more information. ;; ;; Thanks to Marc Battyani for the LW port and for bugfixes, to -;; Johannes Grødem <johs(a)copyleft.no> for a fix to parsing of DATE +;; Johannes GrÃždem <johs(a)copyleft.no> for a fix to parsing of DATE ;; types, to Doug McNaught and Howard Ding for bugfixes, to Ernst ;; Jeschek for pointing out a bug in float parsing, to Brian Lui for ;; providing fixes for ACL6, to James Anderson for providing a fix for @@ -222,6 +205,11 @@ (defgeneric pg-close-portal (connection portal) (:documentation "Closes a prepared statement")) + +(defgeneric pglo-read (connection fd bytes) + (:documentation + "Read from a large object on file descriptor FD.")) + ;; first attempt to connect to connect using the v3 protocol; if this ;; results in an ErrorResponse we close the connection and retry using

1 0

[pg-cvs] CVS update: pg/sysdep.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv8991 Modified Files: sysdep.lisp Log Message: Use the updated MD5 code, that operates on octet arrays rather than strings. Date: Sun Jul 17 17:46:32 2005 Author: emarsden Index: pg/sysdep.lisp diff -u pg/sysdep.lisp:1.8 pg/sysdep.lisp:1.9 --- pg/sysdep.lisp:1.8 Sun Jul 17 15:46:50 2005 +++ pg/sysdep.lisp Sun Jul 17 17:46:32 2005 @@ -1,6 +1,6 @@ ;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp ;;; -;;; Author: Eric Marsden <emarsden(a)laas.fr> +;;; Author: Eric Marsden <eric.marsden(a)free.fr> ;;; Time-stamp: <2005-07-17 emarsden> ;; ;; @@ -11,11 +11,10 @@ #+allegro (require :socket) #+lispworks (require "comm") #+cormanlisp (require :sockets) - #+sbcl (progn (require :asdf) (require :sb-bsd-sockets) (require :sb-md5)) + #+sbcl (require :sb-bsd-sockets) #+(and mcl (not openmcl)) (require "OPENTRANSPORT")) - (defmacro %sysdep (desc &rest forms) (when (null forms) (error "No system dependent code to ~A" desc)) @@ -44,8 +43,9 @@ (defun md5-digest (string &rest strings) (declare (type simple-string string)) - (let ((vec (md5:md5sum-sequence - (apply #'concatenate 'string string strings)))) + (let ((vec (md5sum-sequence + (map '(vector (unsigned-byte 8)) #'char-code + (apply #'concatenate 'string string strings))))) (format nil "~(~{~2,'0X~}~)" (coerce vec 'list)))) (defun md5-encode-password (user password salt)

1 0

[pg-cvs] CVS update: pg/pg-tests.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv479 Modified Files: pg-tests.lisp Log Message: Minor fix to tests for PostgreSQL 8.0: the MONEY type is deprecated. Date: Sun Jul 17 15:49:43 2005 Author: emarsden Index: pg/pg-tests.lisp diff -u pg/pg-tests.lisp:1.9 pg/pg-tests.lisp:1.10 --- pg/pg-tests.lisp:1.9 Tue Sep 7 14:52:19 2004 +++ pg/pg-tests.lisp Sun Jul 17 15:49:43 2005 @@ -10,7 +10,8 @@ (defpackage :pg-tests (:use :cl :pg - #+cmu :fwrappers)) + #+cmu :fwrappers) + (:export #:test)) (in-package :pg-tests) (defmacro with-pg-connection/2 ((con &rest open-args) &body body) @@ -387,8 +388,8 @@ ;; client encoding supported since PostgreSQL v7.1 (format t "Client encoding is ~A~%" (pg-client-encoding conn)) (format t "Date style is ~A~%" (pg-date-style conn)) - (let ((r2 (pg-exec conn "CREATE TABLE pgltest (a int, b float, c money)")) - (r3 (pg-exec conn "INSERT INTO pgltest VALUES (3, -1234.5e67, '$123.45')")) + (let ((r2 (pg-exec conn "CREATE TABLE pgltest (a int, b float, c numeric)")) + (r3 (pg-exec conn "INSERT INTO pgltest VALUES (3, -1234.5e67, 123.45)")) (r4 (pg-exec conn "DROP TABLE pgltest"))) (format t "~%==============================================~%") (format t "status of CREATE is ~s~%" (pg-result r2 :status))

1 0

[pg-cvs] CVS update: pg/parsers.lisp pg/sysdep.lisp pg/v3-protocol.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/pg/cvsroot/pg In directory common-lisp.net:/tmp/cvs-serv32538 Modified Files: parsers.lisp sysdep.lisp v3-protocol.lisp Log Message: Three fixes from Björn Lindberg <d95-bli(a)nada.kth.se>: - Two trivial bugs with regards to use with Allegro - Handling of the special timestamp values infinity and -infinity. They gave an error, but now returns the symbols :INFINITY and :-INFINITY respectively. - A bug in the version 3 of the protocol, where it would return NIL for fields in the database containing the empty string, rather than an empty string. Date: Sun Jul 17 15:46:50 2005 Author: emarsden Index: pg/parsers.lisp diff -u pg/parsers.lisp:1.6 pg/parsers.lisp:1.7 --- pg/parsers.lisp:1.6 Tue Sep 7 14:52:19 2004 +++ pg/parsers.lisp Sun Jul 17 15:46:50 2005 @@ -170,9 +170,14 @@ ;; for a fix for timestamp format in PostgreSQL 7.3 (with or without ;; tz, with or without milliseconds). (defun timestamp-parser (str) - (multiple-value-bind (year month day hours minutes seconds) - (parse-timestamp str) - (encode-universal-time seconds minutes hours day month year))) + ;; Test for the special values 'infinity' and '-infinity' + (cond ((digit-char-p (schar str 0)) + (multiple-value-bind (year month day hours minutes seconds) + (parse-timestamp str) + (encode-universal-time seconds minutes hours day month year))) + ((equal str "infinity") :infinity) + ((equal str "-infinity") :-infinity) + (t (error "Unknown special timestamp value ~A" str)))) (defun precise-timestamp-parser (str) (multiple-value-bind (year month day hours minutes seconds milliseconds) Index: pg/sysdep.lisp diff -u pg/sysdep.lisp:1.7 pg/sysdep.lisp:1.8 --- pg/sysdep.lisp:1.7 Wed May 4 22:51:35 2005 +++ pg/sysdep.lisp Sun Jul 17 15:46:50 2005 @@ -1,7 +1,7 @@ ;;; sysdep.lisp -- system-dependent parts of pg-dot-lisp ;;; ;;; Author: Eric Marsden <emarsden(a)laas.fr> -;;; Time-stamp: <2004-04-23 emarsden> +;;; Time-stamp: <2005-07-17 emarsden> ;; ;; @@ -261,7 +261,6 @@ end) -;; there seems to be a bug in ECL's binary socket streams; data is corrupted #+ecl (defun socket-connect (port host) (declare (type integer port)) @@ -320,8 +319,9 @@ (%sysdep "convert string to bytes" #+(and clisp unicode) (ext:convert-string-to-bytes string encoding) - #+(and acl ics) - (excl:string-to-octets string :external-format encoding) + #+(and allegro ics) + (excl:string-to-octets string :null-terminate nil + :external-format encoding) #+(and :sbcl :sb-unicode) (sb-ext:string-to-octets string :external-format (sbcl-ext-form-from-client-encoding encoding)) #+(or cmu sbcl gcl ecl) @@ -333,8 +333,8 @@ (%sysdep "convert octet-array to string" #+(and clisp unicode) (ext:convert-string-from-bytes bytes encoding) - #+(and acl ics) - (ext:octets-to-string bytes :external-format encoding) + #+(and allegro ics) + (excl:octets-to-string bytes :external-format encoding) #+(and :sbcl :sb-unicode) (sb-ext:octets-to-string bytes :external-format encoding) ;; for implementations that have no support for character Index: pg/v3-protocol.lisp diff -u pg/v3-protocol.lisp:1.15 pg/v3-protocol.lisp:1.16 --- pg/v3-protocol.lisp:1.15 Mon Sep 20 00:32:33 2004 +++ pg/v3-protocol.lisp Sun Jul 17 15:46:50 2005 @@ -270,8 +270,6 @@ "Reads a string of LENGTH characters from the packet") (:method ((packet pg-packet) (length (eql -1))) nil) - (:method ((packet pg-packet) (length (eql 0))) - nil) (:method ((packet pg-packet) (length integer)) (when (< length 0) (error "length cannot be negative. is: ~S"

1 0