Changeset 15517 for release/4/postgresql/trunk/postgresql.scm

Timestamp:

08/20/09 04:03:09 (13 months ago)

Author:

sjamaan

Message:

Implement transaction support (including nested transactions)

Files:

• release/4/postgresql/trunk/postgresql.scm (modified) (4 diffs)

release/4/postgresql/trunk/postgresql.scm

@@ -27 +27 @@
   connect reset-connection disconnect connection?
   
-  multi-query query query*
+  multi-query query query* with-transaction in-transaction?
   
   result? clear-result! row-count column-count
@@ -218 +218 @@
 ;;;;;;;;;;;;;;;;;;;;
 
-(define-record pg-connection ptr type-parsers oid-parsers type-unparsers)
+(define-record
+  pg-connection ptr
+  type-parsers oid-parsers type-unparsers
+  transaction-depth)
 (define connection? pg-connection?)
 
@@ -275 +278 @@
      (else
       (let ((conn (make-pg-connection conn-ptr type-parsers
-                                      (make-hash-table) type-unparsers)))
+                                      (make-hash-table) type-unparsers 0)))
         ;; We don't want libpq to piss in our stderr stream
         ((foreign-lambda* void ((pgconn* conn))
@@ -621 +624 @@
                          conn query params format))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Transaction management
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (with-transaction conn thunk)
+  (let* ((old-depth (pg-connection-transaction-depth conn))
+         (rollback!
+          (lambda ()
+            (if (= old-depth 0)
+                (query conn "ROLLBACK")
+                ;; We do not *need* to give savepoints unique names,
+                ;; but it aids debugging and we know the depth anyway.
+                (query conn (conc "ROLLBACK TO SAVEPOINT s_" old-depth)))))
+         (commit!
+          (lambda ()
+            (if (= old-depth 0)
+                (query conn "COMMIT")
+                (query conn (conc "RELEASE SAVEPOINT s_" old-depth))))))
+    (if (= old-depth 0)
+        (query conn "BEGIN")
+        (query conn (conc "SAVEPOINT s_" old-depth)))
+    (pg-connection-transaction-depth-set! conn (add1 old-depth))
+    ;; TODO: Add a warning mechanism (using dynamic-wind) for when the
+    ;; user tries to jump into/out of transactions with continuations?
+    (handle-exceptions exn
+      (begin
+        (pg-connection-transaction-depth-set! conn old-depth)
+        (rollback!)
+        (raise exn))
+      (let ((res (thunk)))
+        (pg-connection-transaction-depth-set! conn old-depth)
+        (if res (commit!) (rollback!))
+        res))))
+
+(define (in-transaction? conn)
+  (> (pg-connection-transaction-depth conn) 0))
+
 ;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Value escaping