From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 16 Jan 2005 04:17:41 +0000 (+0000)
Subject: Add support for COPY operation and BYTEA type.
X-Git-Tag: 20090517-FFI~1388
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=76f84a3efcda52745d7a407fa686b0fae0f649b5;p=mit-scheme.git

Add support for COPY operation and BYTEA type.
---

diff --git a/v7/src/runtime/pgsql.scm b/v7/src/runtime/pgsql.scm
index 5aca155e9..2d6a09905 100644
--- a/v7/src/runtime/pgsql.scm
+++ b/v7/src/runtime/pgsql.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: pgsql.scm,v 1.10 2004/12/28 06:42:25 cph Exp $
+$Id: pgsql.scm,v 1.11 2005/01/16 04:17:24 cph Exp $
 
-Copyright 2003,2004 Massachusetts Institute of Technology
+Copyright 2003,2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -36,12 +36,15 @@ USA.
   (pq-connect-poll 1)
   (pq-connect-start 2)
   (pq-db 1)
+  (pq-end-copy 1)
   (pq-error-message 1)
+  (pq-escape-bytea 1)
   (pq-escape-string 2)
   (pq-exec 3)
   (pq-field-name 2)
   (pq-finish 1)
   (pq-get-is-null? 3)
+  (pq-get-line 2)
   (pq-get-value 3)
   (pq-host 1)
   (pq-make-empty-pg-result 3)
@@ -50,6 +53,7 @@ USA.
   (pq-options 1)
   (pq-pass 1)
   (pq-port 1)
+  (pq-put-line 2)
   (pq-res-status 1)
   (pq-reset 1)
   (pq-reset-poll 1)
@@ -58,6 +62,7 @@ USA.
   (pq-result-status 1)
   (pq-status 1)
   (pq-tty 1)
+  (pq-unescape-bytea 1)
   (pq-user 1))
 
 (define-syntax define-enum
@@ -281,13 +286,30 @@ USA.
 
 (define (pgsql-conn-status connection)
   (index->name (pq-status (connection->handle connection)) connection-status))
-
+
+(define (pgsql-get-line connection buffer)
+  (pq-get-line (connection->handle connection) buffer))
+
+(define (pgsql-put-line connection buffer)
+  (pq-put-line (connection->handle connection) buffer))
+
+(define (pgsql-end-copy connection)
+  (pq-end-copy (connection->handle connection)))
+
 (define (escape-pgsql-string string)
   (guarantee-pgsql-available)
   (let ((escaped (make-string (fix:* 2 (string-length string)))))
     (set-string-maximum-length! escaped (pq-escape-string string escaped))
     escaped))
 
+(define (encode-pgsql-bytea bytes)
+  (guarantee-pgsql-available)
+  (pq-escape-bytea bytes))
+
+(define (decode-pgsql-bytea string)
+  (guarantee-pgsql-available)
+  (pq-unescape-bytea string))
+
 (define (exec-pgsql-query connection query)
   (guarantee-string query 'EXEC-PGSQL-QUERY)
   (let ((result
@@ -300,13 +322,13 @@ USA.
 	      (if (= 0 result-handle)
 		  (error "Unable to execute PostgreSQL query:" query))
 	      (make-result result-handle))))))
-    (if (memq (pgsql-result-status result)
-	      '(PGSQL-COMMAND-OK
-		PGSQL-TUPLES-OK
-		PGSQL-COPY-OUT
-		PGSQL-COPY-IN))
-	result
-	(error:pgsql-query query result))))
+    (if (not (memq (pgsql-result-status result)
+		   '(PGSQL-COMMAND-OK
+		     PGSQL-TUPLES-OK
+		     PGSQL-COPY-OUT
+		     PGSQL-COPY-IN)))
+	(error:pgsql-query query result))
+    result))
 
 (define (make-empty-pgsql-result connection status)
   (let ((handle (connection->handle connection)))
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 9c1726b8d..394a0a953 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.527 2005/01/11 03:57:00 cph Exp $
+$Id: runtime.pkg,v 14.528 2005/01/16 04:17:41 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -4722,6 +4722,8 @@ USA.
 	  condition-type:pgsql-connection-error
 	  condition-type:pgsql-error
 	  condition-type:pgsql-query-error
+	  decode-pgsql-bytea
+	  encode-pgsql-bytea
 	  escape-pgsql-string
 	  exec-pgsql-query
 	  guarantee-pgsql-available
@@ -4758,6 +4760,7 @@ USA.
 	  pgsql-fatal-error
 	  pgsql-field-name
 	  pgsql-get-is-null?
+	  pgsql-get-line
 	  pgsql-get-value
 	  pgsql-n-fields
 	  pgsql-n-tuples
@@ -4767,6 +4770,7 @@ USA.
 	  pgsql-polling-ok
 	  pgsql-polling-reading
 	  pgsql-polling-writing
+	  pgsql-put-line
 	  pgsql-result-error-message
 	  pgsql-result-status
 	  pgsql-tuples-ok