[pg-cvs] CVS pg

[emarsden]

Update of /project/pg/cvsroot/pg
In directory clnet:/tmp/cvs-serv3853

Modified Files:
	README pg.lisp utility.lisp v2-protocol.lisp v3-protocol.lisp 
Log Message:
Add an ABORT keyword argument to PG-DISCONNECT (from Robert J.
Macomber <pgsql at rojoma.com>), as per CL:CLOSE. 

  "I've run into a problem with pg-disconnect if something abnormal
   happens to the database connection -- if the database goes away for a
   restart while pg has a connection open, for example.  When this
   happens, pg-disconnect fails, and the socket file descriptor is left
   open (presumably for a finalizer to clean up), also raising a new
   error from the unwind-protect in with-pg-connection.  To guard against
   the possibility, I've added an :abort parameter to pg-disconnect, like
   cl:close has, and made with-pg-connection call it with :abort t if the
   body exits abnormally, in the same way that with-open-file operates.
   When :abort is true, the modified pg-disconnect closes the database
   connection ungracefully, including making the close call abort
   (otherwise, sbcl at keast tries to flush the stream, raising another
   error if the database isn't there anymore)."


--- /project/pg/cvsroot/pg/README	2006/09/23 12:24:28	1.9
+++ /project/pg/cvsroot/pg/README	2006/11/20 20:50:36	1.10
@@ -102,8 +102,11 @@
      you have a large amount of data to handle, this usage is more
      efficient than fetching all the tuples in one go.
 
- (pg-disconnect connection) -> nil
-     Close the database connection.
+ (pg-disconnect connection &key abort) -> nil
+     Close the database connection. If the keyword argument ABORT is
+     non-NIL, the database connection is closed immediately, without
+     first attempting to send a disconnect packet to the PostgreSQL
+     backend. 
 
 
 === Support for prepared statements ====================================
--- /project/pg/cvsroot/pg/pg.lisp	2006/11/19 18:47:58	1.10
+++ /project/pg/cvsroot/pg/pg.lisp	2006/11/20 20:50:36	1.11
@@ -174,7 +174,7 @@
  element in the pg_proc table, and otherwise it is a string which we
 look up in the alist *lo-functions* to find the corresponding OID."))
 
-(defgeneric pg-disconnect (connection)
+(defgeneric pg-disconnect (connection &key abort)
   (:documentation
    "Disconnects from the DB"))
 
--- /project/pg/cvsroot/pg/utility.lisp	2006/10/22 19:22:39	1.2
+++ /project/pg/cvsroot/pg/utility.lisp	2006/11/20 20:50:36	1.3
@@ -36,10 +36,14 @@
 CONNECTION. If the connection is unsuccessful, the forms are not
 evaluated. Otherwise, the BODY forms are executed, and upon
 termination, normal or otherwise, the database connection is closed."
-  `(let ((,con (pg-connect , at open-args)))
-     (unwind-protect
-         (progn , at body)
-       (when ,con (pg-disconnect ,con)))))
+  (let ((ok (gensym)))
+    `(let ((,con (pg-connect , at open-args))
+           (,ok nil))
+       (unwind-protect
+           (multiple-value-prog1
+               (progn , at body)
+             (setf ,ok t))
+         (when ,con (pg-disconnect ,con :abort (not ,ok)))))))
 
 ;; this is the old version
 #+(or)
--- /project/pg/cvsroot/pg/v2-protocol.lisp	2006/11/19 18:47:59	1.6
+++ /project/pg/cvsroot/pg/v2-protocol.lisp	2006/11/20 20:50:36	1.7
@@ -237,10 +237,14 @@
                       :reason (format nil "Unexpected byte ~s" b)))))))
 
 
-(defmethod pg-disconnect ((connection pgcon-v2))
-  (write-byte 88 (pgcon-stream connection))
-  (%flush connection)
-  (close (pgcon-stream connection))
+(defmethod pg-disconnect ((connection pgcon-v2) &key abort)
+  (cond
+    (abort
+     (close (pgcon-stream connection) :abort t))
+    (t
+     (write-byte 88 (pgcon-stream connection))
+     (%flush connection)
+     (close (pgcon-stream connection))))
   (values))
 
 
--- /project/pg/cvsroot/pg/v3-protocol.lisp	2006/11/19 18:47:59	1.28
+++ /project/pg/cvsroot/pg/v3-protocol.lisp	2006/11/20 20:50:36	1.29
@@ -641,10 +641,14 @@
     (do-followup-query connection)))
 
 
-(defmethod pg-disconnect ((connection pgcon-v3))
-  (send-packet connection #\X nil)
-  (%flush connection)
-  (close (pgcon-stream connection))
+(defmethod pg-disconnect ((connection pgcon-v3) &key abort)
+  (cond
+    (abort
+     (close (pgcon-stream connection) :abort t))
+    (t
+     (send-packet connection #\X nil)
+     (%flush connection)
+     (close (pgcon-stream connection))))
   (values))