Stephen Compall committed c2f5ed9

Add alternative "dynamic" store API.

This is for stores that can't implement the traditional
begin/commit/rollback trio. We warn that non-local exit behavior may
be non-consistent with stores that use this alternative API.

Comments (0)

Files changed (2)


    weblocks transaction functions over all stores"
   (if (eq (request-method) :post)
       (let (tx-error-occurred-p)
-	(unwind-protect
-	     (handler-bind ((error #'(lambda (error)
-				       (declare (ignore error))
-				       (mapstores #'rollback-transaction)
-				       (setf tx-error-occurred-p t))))
-	       (mapstores #'begin-transaction)
-	       (eval-dynamic-hooks hooks))
-	  (unless tx-error-occurred-p
-	    (mapstores #'commit-transaction))))
+	(multiple-value-bind (dynamic-stores non-dynamic-stores)
+	    (loop for store-name in *store-names*
+		  for store = (symbol-value store-name)
+		  when store
+		    if (use-dynamic-transaction-p store)
+		      collect store into dynamic-stores
+		    else collect store into non-dynamic-stores
+		  finally (return (values dynamic-stores non-dynamic-stores)))
+	  (labels ((dynamic-transactions (stores)
+		     (if (null stores)
+			 (eval-dynamic-hooks hooks)
+			 (dynamic-transaction
+			  (car stores)
+			  (f0 (dynamic-transactions (cdr stores))))))
+		   (handle-error (error)
+		     (declare (ignore error))
+		     (mapc #'rollback-transaction non-dynamic-stores)
+		     (setf tx-error-occurred-p t)))
+	    (unwind-protect
+		 (handler-bind ((error #'handle-error))
+		   (mapc #'begin-transaction non-dynamic-stores)
+		   (dynamic-transactions dynamic-stores))
+	      (unless tx-error-occurred-p
+		(mapc #'commit-transaction non-dynamic-stores))))))
       (eval-dynamic-hooks hooks)))
 (eval-when (:load-toplevel)


 (export '(open-store close-store clean-store *default-store*
 	  begin-transaction commit-transaction rollback-transaction
+	  dynamic-transaction use-dynamic-transaction-p
 	  persist-object delete-persistent-object
 	  delete-persistent-object-by-id find-persistent-objects
 	  find-persistent-object-by-id count-persistent-objects))
   isn't in a transaction, this function should return NIL without
   signalling errors."))
+(defgeneric dynamic-transaction (store proc)
+  (:documentation "Call PROC, a thunk, while in a transaction of
+  STORE.  See `use-dynamic-transaction-p' for details.")
+  (:method (store proc)
+    (warn "~S should not be called when the other transaction ~
+	   interface is available" 'dynamic-transaction)
+    (let (tx-error-occurred-p)
+      (unwind-protect
+	   (handler-bind ((error #'(lambda (error)
+				     (declare (ignore error))
+				     (rollback-transaction store)
+				     (setf tx-error-occurred-p t))))
+	     (begin-transaction store)
+	     (funcall proc))
+	(unless tx-error-occurred-p
+	  (commit-transaction store))))))
+(defgeneric use-dynamic-transaction-p (store)
+  (:documentation "Answer whether `action-txn-hook' and equivalents
+  should use GF `dynamic-transaction' for transaction control rather
+  than the `begin-transaction', `commit-transaction', and
+  `rollback-transaction' GFs.  Be warned that non-local exit behavior
+  for stores that answer true for this may have unique non-local exit
+  unwind behavior.")
+  (:method (store)
+    (declare (ignore store))
+    nil))
 ;;; Creating and deleting persistent objects
 (defgeneric persist-object (store object)
   (:documentation "Persists 'object' into 'store'. If the object does