From emarsden at common-lisp.net  Mon Dec 19 22:16:43 2005
From: emarsden at common-lisp.net (Eric Marsden)
Date: Mon, 19 Dec 2005 23:16:43 +0100 (CET)
Subject: [pg-cvs] CVS update: pg/meta-queries.lisp 
Message-ID: <20051219221643.BF74A88446@common-lisp.net>

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 at laas.fr>
-;;; Time-stamp: <2004-03-05 emarsden>
+;;; Author: Eric Marsden <eric.marsden at 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



From emarsden at common-lisp.net  Mon Dec 19 22:18:54 2005
From: emarsden at common-lisp.net (Eric Marsden)
Date: Mon, 19 Dec 2005 23:18:54 +0100 (CET)
Subject: [pg-cvs] CVS update: pg/sysdep.lisp 
Message-ID: <20051219221854.752A888446@common-lisp.net>

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 at 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))))
 



From emarsden at common-lisp.net  Mon Dec 19 22:21:51 2005
From: emarsden at common-lisp.net (Eric Marsden)
Date: Mon, 19 Dec 2005 23:21:51 +0100 (CET)
Subject: [pg-cvs] CVS update: pg/sysdep.lisp 
Message-ID: <20051219222151.72D3288446@common-lisp.net>

Update of /project/pg/cvsroot/pg
In directory common-lisp.net:/tmp/cvs-serv4507

Modified Files:
	sysdep.lisp 
Log Message:
Fix the SB-ROTATE-BYTE dependency for SBCL (was loaded twice, with
unfortunate consequences).

Add support for unix-socket connections to the backend for SBCL.

(Thanks to Andreas Fuchs)

Date: Mon Dec 19 23:21:50 2005
Author: emarsden

Index: pg/sysdep.lisp
diff -u pg/sysdep.lisp:1.11 pg/sysdep.lisp:1.12
--- pg/sysdep.lisp:1.11	Mon Dec 19 23:18:32 2005
+++ pg/sysdep.lisp	Mon Dec 19 23:21:50 2005
@@ -146,27 +146,30 @@
              :transport-error e))))
 
 #+sbcl
-(defun socket-connect (port host)
+(defun socket-connect (port host-name)
   (declare (type integer port))
-  (handler-case
-      (sb-bsd-sockets:socket-make-stream
-       (if host
-	   (let ((s (make-instance 'sb-bsd-sockets:inet-socket
-                                   :type :stream :protocol :tcp))
-		 (num (car (sb-bsd-sockets:host-ent-addresses
-			    (sb-bsd-sockets:get-host-by-name host)))))
-	     (sb-bsd-sockets:socket-connect s num port)
-             s)
-	   (let ((s (make-instance 'sb-bsd-sockets:local-socket :type :stream)))
-	     (sb-bsd-sockets:socket-connect
-	      s (format nil "/var/run/postgresql/.s.PGSQL.~D" port))
-	     s))
-       :element-type '(unsigned-byte 8)
-       :input t
-       :output t
-       :buffering :none)
-    (error (e)
-      (error 'connection-failure :host host :port port :transport-error e))))
+  (let ((host (if (typep host-name 'pathname)
+                  (namestring host-name)
+                  host-name)))
+    (handler-case
+        (sb-bsd-sockets:socket-make-stream
+         (if (eql #\/ (char host 0))
+             (let ((s (make-instance 'sb-bsd-sockets:local-socket :type :stream)))
+               (sb-bsd-sockets:socket-connect
+                s (format nil  "~A.s.PGSQL.~D" (string host) port))
+               s)
+             (let ((s (make-instance 'sb-bsd-sockets:inet-socket
+                         :type :stream :protocol :tcp))
+                   (num (car (sb-bsd-sockets:host-ent-addresses
+                              (sb-bsd-sockets:get-host-by-name host)))))
+               (sb-bsd-sockets:socket-connect s num port)
+               s))
+         :element-type '(unsigned-byte 8)
+         :input t
+         :output t
+         :buffering :none)
+      (error (e)
+        (error 'connection-failure :host host :port port :transport-error e)))))
 
 #+allegro
 (defun socket-connect (port host)



From emarsden at common-lisp.net  Mon Dec 19 22:30:04 2005
From: emarsden at common-lisp.net (Eric Marsden)
Date: Mon, 19 Dec 2005 23:30:04 +0100 (CET)
Subject: [pg-cvs] CVS update: pg/parsers.lisp pg/CREDITS pg/README 
Message-ID: <20051219223004.B94D688446@common-lisp.net>

Update of /project/pg/cvsroot/pg
In directory common-lisp.net:/tmp/cvs-serv4581

Modified Files:
	parsers.lisp CREDITS README 
Log Message:
Fix to timezone handling when parsing timestamps (timezone offset can
be negative).

>From Katsuya Tomioka.

Date: Mon Dec 19 23:30:00 2005
Author: emarsden

Index: pg/parsers.lisp
diff -u pg/parsers.lisp:1.7 pg/parsers.lisp:1.8
--- pg/parsers.lisp:1.7	Sun Jul 17 15:46:50 2005
+++ pg/parsers.lisp	Mon Dec 19 23:29:59 2005
@@ -1,6 +1,6 @@
 ;;; parsers.lisp -- type coercion support
 ;;;
-;;; Author: Eric Marsden <emarsden at laas.fr>
+;;; Author: Eric Marsden <eric.marsden at free.fr>
 ;;
 ;;
 ;; When returning data from a SELECT statement, PostgreSQL starts by
@@ -65,6 +65,7 @@
 
 (defvar *type-parsers*
   `(("bool"      . ,'bool-parser)
+    ("bytea"     . ,'identity)
     ("char"      . ,'text-parser)
     ("char2"     . ,'text-parser)
     ("char4"     . ,'text-parser)
@@ -76,7 +77,11 @@
     ("int2"      . ,'integer-parser)
     ("int4"      . ,'integer-parser)
     ("int8"      . ,'integer-parser)
+    ;; int2vector
     ("oid"       . ,'integer-parser)
+    ;; oidvector
+    ;; bit
+    ;; varbit
     ("float4"    . ,'float-parser)
     ("float8"    . ,'float-parser)
     ("money"     . ,'text-parser)       ; "$12.34"
@@ -153,7 +158,7 @@
          (minutes (parse-integer str :start 14 :end 16))
          (seconds (parse-integer str :start 17 :end 19))
          (length (length str))
-         (start-tz (if (eql #\+ (char str (- length 3)))
+         (start-tz (if (find (char str (- length 3)) "+-")
                        (- length 3)))
          (tz (when start-tz
                (parse-integer str :start start-tz)))


Index: pg/CREDITS
diff -u pg/CREDITS:1.4 pg/CREDITS:1.5
--- pg/CREDITS:1.4	Tue Sep  7 14:52:19 2004
+++ pg/CREDITS	Mon Dec 19 23:29:59 2005
@@ -30,3 +30,12 @@
 
 Risto Sakari Laakso:
   Provided a parser for the NUMERIC type
+
+Andreas Fuchs
+  Patch to allow connection via a unix socket with SBCL
+
+Katsuya Tomioka
+  Patch to timezone handling in timestamp parsing
+
+
+(apologies for people who have been forgotten in this file)


Index: pg/README
diff -u pg/README:1.4 pg/README:1.5
--- pg/README:1.4	Sun Jul 17 17:49:14 2005
+++ pg/README	Mon Dec 19 23:29:59 2005
@@ -1,10 +1,10 @@
 pg.lisp -- socket level interface to the PostgreSQL RDBMS for Common Lisp
 
  Author: Eric Marsden <eric.marsden at free.fr>
- Time-stamp: <2005-07-17 emarsden>
+ Time-stamp: <2005-12-19 emarsden>
  Version: 0.22
 
-     Copyright (C) 1999,2000,2001,2002,2003,2004  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
@@ -244,16 +244,16 @@
     end of the tunnel, since pg.lisp defaults to this value.
 
 
-This code has been tested or reported to work with
+At various times, this code has been tested or reported to work with
 
-   * CMUCL 18d, 18e, 19a on Solaris/SPARC and Linux/x86
-   * SBCL 0.9.2 on Linux/x86
+   * CMUCL 18d, 18e, 19a, 19c on Solaris/SPARC and Linux/x86
+   * SBCL 0.9.2 to 0.9.7 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, 8.0
+   * PostgreSQL versions 6.5, 7.0, 7.1.2, 7.2, 7.3, 7.4, 8.0, 8.1
 
 
 You may be interested in using "pg-psql" by Harley Gorrell, which