[pg-cvs] CVS update: pg/defpackage.lisp pg/v3-protocol.lisp

[Peter Van Eynde]

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

Modified Files:
	defpackage.lisp v3-protocol.lisp 
Log Message:
untested COPY IN/OUT code. I am not happy about how this looks...
Date: Tue Mar  9 11:27:20 2004
Author: pvaneynde

Index: pg/defpackage.lisp
diff -u pg/defpackage.lisp:1.2 pg/defpackage.lisp:1.3
--- pg/defpackage.lisp:1.2	Mon Mar  8 09:38:07 2004
+++ pg/defpackage.lisp	Tue Mar  9 11:27:20 2004
@@ -6,6 +6,7 @@
         #+openmcl :ccl)
   #+openmcl (:shadow ccl:socket-connect)
   (:export #:pg-connect #:pg-exec #:pg-result #:pg-disconnect
+	   #:pgcon-sql-stream
            #:*pg-disable-type-coercion*
            #:pg-databases #:pg-tables #:pg-columns
            #:pg-backend-version


Index: pg/v3-protocol.lisp
diff -u pg/v3-protocol.lisp:1.5 pg/v3-protocol.lisp:1.6
--- pg/v3-protocol.lisp:1.5	Mon Mar  8 13:12:45 2004
+++ pg/v3-protocol.lisp	Tue Mar  9 11:27:20 2004
@@ -7,8 +7,10 @@
 
 (defclass pgcon-v3 (pgcon)
   ((parameters  :accessor pgcon-parameters
-                :initform (list))))
-
+                :initform (list))
+   (sql-stream  :initform nil
+		:accessor pgcon-sql-stream
+		:type (or nil stream))))
 
 
 (define-condition error-response (postgresql-error)
@@ -279,7 +281,8 @@
                                 ((:byte :char) 1)
                                 ((:int16) 2)
                                 ((:int32) 4)
-                                ((:cstring)
+                                ((:cstring
+				  :rawdata)
                                  (+ 1
                                     (length value)))))))
          (data (make-array (- length 4)
@@ -320,7 +323,12 @@
                          (char-code char))
                    (incf position))
              (setf (elt data position) 0)
-             (incf position))))
+             (incf position))
+	    ((:rawdata)
+             (check-type value (array (unsigned-byte 8) *))
+
+	     (replace data value :start1 position)
+	     (incf position (length value)))))
 
     (%send-net-int stream (char-code code) 1)
     (%send-net-int stream length 4 )
@@ -449,6 +457,7 @@
     (loop
      :for packet = (read-packet connection)
      :with got-data-p = nil
+     :with receive-data-p = nil
      :do
      (when packet
        (case (pg-packet-type packet)
@@ -472,27 +481,72 @@
           (setf got-data-p t))
          ((#\G)
           ;; CopyInResponse
-          (cerror "Just ignore it" "What to do with #\G?")
-          ;; The backend is ready to copy data from the frontend to a table;
-          ;; see Section 44.2.5 in http://www.postgresql.org/docs/7.4/interactive/protocol-flow.html
-          ;; for now we make it fail gracefully:
-          (send-packet connection
-                       #\f
-                       ;;CopyFail
-                       '((:cstring "not implemented by pg.lisp yet")))
-          )
+	  (cond
+	    ((and (streamp (pgcon-sql-stream connection))
+		  (input-stream-p (pgcon-sql-stream connection)))
+	     ;; we ignore the data stuff.
+	     (handler-case
+	      (progn
+		(loop :with buffer = (make-array 4096
+						 :element-type '(unsigned-byte 8)
+						 :adjustable t)
+		      :for length = (read-sequence buffer (pgcon-sql-stream connection))
+		      :until (= length 0)
+		      :do
+		      ;; send data
+		      (unless (= length 4096)
+			(setf buffer
+			      (adjust-array buffer (list length))))
+		      (send-packet connection
+				   #\d
+				   `((:rawdata ,buffer))))
+		
+		;; CopyDone
+		(send-packet connection
+			     #\c
+			     nil))
+	      ((or error serious-condition) (condition)
+	       (warn "Got an error while writing sql data: ~S aborting transfer!"
+		     condition)
+	       (send-packet connection
+			    #\f
+			    ;;CopyFail
+			    '((:cstring "No input data provided")))))
+	     (%flush connection))
+	    (t
+	     (warn "We had to provide data, but my sql-stream isn't an input-stream. Aborting transfer")
+
+	     (send-packet connection
+			  #\f
+			  ;;CopyFail
+			  '((:cstring "No input data provided"))))))
          ((#\H)
           ;; CopyOutResponse
-          (cerror "Just ignore it" "What to do with #\H?")
-          ;; The backend is ready to copy data from a table to the frontend;
-          ;; see Section 44.2.5.
-          ;; for now we make it fail gracefully (we cannot stop the transfer...
-          )
-         (( #\d
-            ;; CopyData
-            #\c
-            ;;CopyDone
-            )
+	  (cond
+	    ((and (streamp (pgcon-sql-stream connection))
+		  (output-stream-p (pgcon-sql-stream connection)))
+	     (setf receive-data-p t))
+	    (t
+	     (setf receive-data-p nil)
+	     (warn "I should receive data but my sql-stream isn't an outputstream!~%Ignoring data"))))
+         (( #\d)
+	  ;; CopyData
+	  (when receive-data-p
+	    ;; we break the nice packet abstraction here to
+	    ;; get some speed:
+	    (let ((length (read-from-packet packet :int32)))
+	      (write-sequence (make-array length
+					  :element-type '(unsigned-byte 8)
+					  :displaced-to (slot-value packet
+								    'data)
+					  :displaced-index-offset
+					  (slot-value packet 'position))
+			      (pgcon-sql-stream connection)))))
+	 (( #\c )
+	  ;;CopyDone
+	  ;; we do nothing (the exec will return and the user
+	  ;; can do something if he/she wants
+	  (setf receive-data-p nil)
           t)
          ((#\T)
           ;; RowDescription (metadata for subsequent tuples), #\T