r1660: field types

[clsql.git] / interfaces / postgresql-socket / postgresql-socket-api.cl

diff --git a/interfaces/postgresql-socket/postgresql-socket-api.cl b/interfaces/postgresql-socket/postgresql-socket-api.cl
index c97eda18be744cf8a4e8a5455f120bdf83bd5ed8..e8706805e9236c1f6b7584586af442c0c08ad0b1 100644 (file)
--- a/interfaces/postgresql-socket/postgresql-socket-api.cl
+++ b/interfaces/postgresql-socket/postgresql-socket-api.cl
@@ -9,7 +9,7 @@
 ;;;;                
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: postgresql-socket-api.cl,v 1.1 2002/03/23 17:10:48 kevin Exp $
+;;;; $Id: postgresql-socket-api.cl,v 1.4 2002/03/25 23:30:49 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@ -25,10 +25,26 @@
 ;;;;  - Changed CMUCL FFI to UFFI
 ;;;;  - Added necessary (force-output) for socket streams on 
 ;;;;     Allegro and Lispworks
+;;;;  - Added initialization variable
+;;;;  - Added field type processing
 
+ 
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
 (in-package :postgresql-socket)
 
+(uffi:def-enum pgsql-ftype
+    ((:bytea 17)
+     (:int2 21)
+     (:int4 23)
+     (:float4 700)
+     (:float8 701)))
+
+(defmethod database-type-library-loaded ((database-type
+                                         (eql :postgresql-socket)))
+  "T if foreign library was able to be loaded successfully. Always true for
+socket interface"
+  t)
+                                     
 
 ;;; Message I/O stuff
 
@@ -547,7 +563,20 @@ connection, if it is still open."
            do (setf (aref result index) (ldb (byte 1 weight) byte))))
     result))
 
-(defun read-cursor-row (cursor)
+(defun read-field (socket type)
+  (let* ((length (read-socket-value 'int32 socket))
+        (result (make-string (- length 4))))
+    (read-socket-sequence result socket)
+    (case type
+      (:int
+       (parse-integer result))
+      (:double
+       (let ((*read-default-float-format* 'double-float))
+        (read-from-string result)))
+      (t
+       result))))
+
+(defun read-cursor-row (cursor field-types)
   (let* ((connection (postgresql-cursor-connection cursor))
         (socket (postgresql-connection-socket connection))
         (fields (postgresql-cursor-fields cursor)))
@@ -561,15 +590,13 @@ connection, if it is still open."
                     with null-vector = (read-null-bit-vector socket count)
                     repeat count
                     for null-bit across null-vector
+                    for i from 0
                     for null-p = (zerop null-bit)
                     if null-p
                     collect nil
                     else
                     collect
-                    (let* ((length (read-socket-value 'int32 socket))
-                           (result (make-string (- length 4))))
-                      (read-socket-sequence result socket)
-                      result))))
+                    (read-field socket (nth i field-types)))))
            (#.+binary-row-message+
             (error "NYI"))
            (#.+completed-response-message+
@@ -593,7 +620,14 @@ connection, if it is still open."
             (error 'postgresql-fatal-error :connection connection
                    :message "Received garbled message from backend")))))))
 
-(defun copy-cursor-row (cursor sequence)
+(defun map-into-indexed (result-seq func seq)
+  (dotimes (i (length seq))
+    (declare (fixnum i))
+    (setf (elt result-seq i)
+         (funcall func (elt seq i) i)))
+  result-seq)
+
+(defun copy-cursor-row (cursor sequence field-types)
   (let* ((connection (postgresql-cursor-connection cursor))
         (socket (postgresql-connection-socket connection))
         (fields (postgresql-cursor-fields cursor)))
@@ -603,15 +637,21 @@ connection, if it is still open."
          (case code
            (#.+ascii-row-message+
             (return
-              (map-into
+              #+ignore
+              (let* ((count (length sequence))
+                     (null-vector (read-null-bit-vector socket count)))
+                (dotimes (i count)
+                  (declare (fixnum i))
+                  (if (zerop (elt null-vector i))
+                      (setf (elt sequence i) nil)
+                      (let ((value (read-field socket (nth i field-types))))
+                        (setf (elt sequence i) value)))))
+              (map-into-indexed
                sequence
-               #'(lambda (null-bit)
+               #'(lambda (null-bit i)
                    (if (zerop null-bit)
                        nil
-                       (let* ((length (read-socket-value 'int32 socket))
-                              (result (make-string (- length 4))))
-                         (read-socket-sequence result socket)
-                         result)))
+                       (read-field socket (nth i field-types))))
                (read-null-bit-vector socket (length sequence)))))
            (#.+binary-row-message+
             (error "NYI"))
@@ -674,12 +714,12 @@ connection, if it is still open."
             (error 'postgresql-fatal-error :connection connection
                    :message "Received garbled message from backend")))))))
 
-(defun run-query (connection query)
+(defun run-query (connection query &optional (field-types nil))
   (start-query-execution connection query)
   (multiple-value-bind (status cursor)
       (wait-for-query-results connection)
     (assert (eq status :cursor))
-    (loop for row = (read-cursor-row cursor)
+    (loop for row = (read-cursor-row cursor field-types)
          while row
          collect row
          finally