pg-cvs December 2005

pg-cvs@common-lisp.net

1 participants
4 discussions

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

19 Dec '05

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(a)laas.fr> +;;; Author: Eric Marsden <eric.marsden(a)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(a)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

1 0

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

1 0

[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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

pg-cvs December 2005