CCL postgresql-socket with UTF-8

Hi CLSQLers, :)

I tried to send this message via gmane already, but it seemed to have
never appeared on the mailing list.

so - here is a patch against postgresql-socket-api.lisp to have UTF-8
support with CCL (tested withh CCL64/Linux and CCL32/Windows) and
postgresql-socket (against clsql-20110522-git, current quicklisp-dist).

best regards,
  okflo

(in-package #:postgresql-socket)

(defun send-socket-value-string (socket value)
  (declare (type stream socket)
           (type string value))
  #-(or sb-unicode ccl)
  (loop for char across value
        for code = (char-code char)
        do (write-byte code socket)
        finally (write-byte 0 socket))
  #+ccl
  (write-sequence (ccl:encode-string-to-octets
value :external-format :utf-8) socket)
  (write-byte 0 socket)
  #+sb-unicode
  (write-sequence (sb-ext:string-to-octets value :null-terminate t)
socket)
  nil)

(defun read-socket-value-string (socket)
  (declare (type stream socket))
  #-(or sb-unicode ccl)
  (with-output-to-string (out)
    (loop for code = (read-byte socket)
          until (zerop code)
          do (write-char (code-char code) out)))
  #+ccl
  (let ((bytes (make-array 64
                           :element-type '(unsigned-byte 8)
                           :adjustable t
                           :fill-pointer 0)))
    (loop for code = (read-byte socket)
          until (zerop code)
          do (vector-push-extend code bytes))
    (ccl:decode-string-from-octets bytes :external-format :utf-8))
  #+sb-unicode
  (let ((bytes (make-array 64
                           :element-type '(unsigned-byte 8)
                           :adjustable t
                           :fill-pointer 0)))
    (loop for code = (read-byte socket)
          until (zerop code)
          do (vector-push-extend code bytes))
    (sb-ext:octets-to-string bytes)))

(defun read-socket-sequence (stream length &optional (allow-wide t))
  (declare (stream stream)
           (optimize (speed 3) (safety 0)))
  #-(or sb-unicode ccl)
  (let ((result (make-string length)))
    (dotimes (i length result)
      (declare (fixnum i))
      (setf (char result i) (code-char (read-byte stream)))))
  #+ccl
  (let ((bytes (make-array length :element-type '(unsigned-byte 8))))
    (declare (type (simple-array (unsigned-byte 8) (*)) bytes))
    (read-sequence bytes stream)
    (if allow-wide
	(ccl:decode-string-from-octets bytes :external-format :utf-8)
	(map 'string #'code-char bytes)))
  #+sb-unicode
  (let ((bytes (make-array length :element-type '(unsigned-byte 8))))
    (declare (type (simple-array (unsigned-byte 8) (*)) bytes))
    (read-sequence bytes stream)
    (if allow-wide
        (sb-ext:octets-to-string bytes)
        (map 'string #'code-char bytes))))