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