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