Added mechanism so that begin, commit, rollback can be used outside of with-transaction

src/dbd/postgres.lisp

@@ -180,6 +180,7 @@
   (do-sql conn "BEGIN"))
 
 (defmethod commit ((conn dbd-postgres-connection))
+  (declare (ignore state))
   (do-sql conn "COMMIT"))
 
 (defmethod rollback ((conn dbd-postgres-connection))

src/dbd/sqlite3.lisp

@@ -117,7 +117,7 @@
   (sqlite:execute-non-query (connection-handle conn) "BEGIN TRANSACTION")
   (sql-log "BEGIN TRANSACTION" nil nil nil))
 
-(defmethod commit ((conn dbd-sqlite3-connection))
+(defmethod commit ((conn dbd-sqlite3-connection) &opti)
   (sqlite:execute-non-query (connection-handle conn) "COMMIT TRANSACTION")
   (sql-log "COMMIT TRANSACTION" nil nil nil))
 

src/dbi.lisp

@@ -21,6 +21,9 @@
                 #:fetch
                 #:fetch-all
                 #:do-sql
+                #:clear-transaction-state
+                #:end-transaction
+                #:start-transaction
                 #:begin-transaction
                 #:in-transaction
                 #:commit
@@ -52,6 +55,9 @@
            #:fetch
            #:fetch-all
            #:do-sql
+           #:clear-transaction-state
+           #:start-transaction
+           #:end-transaction
            #:begin-transaction
            #:in-transaction
            #:commit

src/driver.lisp

@@ -33,6 +33,9 @@
            #:fetch-using-connection
            #:do-sql
            #:execute-using-connection
+           #:clear-transaction-state
+           #:start-transaction
+           #:end-transaction
            #:begin-transaction
            #:in-transaction
            #:with-savepoint
@@ -245,6 +248,23 @@ This method must be implemented in each drivers.")
         :test #'eql
         :key #'get-conn))
 
+(defun remove-transaction-state (conn)
+  "Remove the transaction state object from the stack."
+  (setf *transaction-state*
+        (remove conn *transaction-state*
+                :test #'eql
+                :key #'get-conn)))
+
+(defun clear-transaction-state (&optional force)
+  (if force
+        (setf *transaction-state* nil)
+        (setf *transaction-state*
+                (remove-if (lambda (state)
+                                 (not (eql (get-state state)
+                                     :in-progress)))
+                             *transaction-state*))))
+
+
 (defun in-transaction (conn)
   "Returns True if called inside a transaction block."
   (not (null (get-transaction-state conn))))
@@ -261,17 +281,18 @@ This method must be implemented in each drivers.")
                     *transaction-state*))
             ,ok)
 
-       (savepoint ,conn ,ident-var)
+       (savepoint ,conn ,ident-var)+
        (unwind-protect
             (multiple-value-prog1
-                (progn ,@body)
+                (progn ,@body)`<
               (setf ,ok t))
          (when (eql (get-state ,state-var)
                     :in-progress)
            (if ,ok
                (release-savepoint ,conn ,ident-var)
                (rollback-savepoint ,conn ,ident-var)))))))
 
+
 (defmacro %with-transaction (conn &body body)
   (let ((ok (gensym "TRANSACTION-OK"))
         (state-var (gensym "STATE-VAR")))
@@ -280,10 +301,10 @@ This method must be implemented in each drivers.")
                              'transaction-state))
             (,state-var (make-instance state-class
                                        :conn ,conn))
-            (*transaction-state*
-              (cons ,state-var
-                    *transaction-state*))
-            ,ok)
+             (*transaction-state*
+               (cons ,state-var
+                     *transaction-state*))
+           ,ok)
        (begin-transaction ,conn)
        (unwind-protect
             (multiple-value-prog1
@@ -303,6 +324,21 @@ This method must be implemented in each drivers.")
            (with-savepoint ,conn-var ,@body)
            (%with-transaction ,conn-var ,@body)))))
 
+(defmethod start-transaction (conn)
+  (let* ((state-class (if (in-transaction conn)
+                          'savepoint-state
+                          'transaction-state))
+         (state-var (make-instance state-class
+                                  :conn conn))
+         )
+    (setf *transaction-state*
+          (cons state-var
+                *transaction-state*))
+    (begin-transaction conn)
+    state-var))
+
+(defmethod end-transaction (conn)
+  (remove-transaction-state conn))
 
 (defun assert-transaction-is-in-progress (transaction-state)
   (case (get-state transaction-state)
@@ -314,7 +350,7 @@ This method must be implemented in each drivers.")
 (defgeneric commit (conn)
   (:documentation "Commit changes and end the current transaction.")
   (:method ((conn dbi-connection))
-    (declare (ignore conn))
+    (declare (ignore conn state))
     (error 'dbi-notsupported-error
            :method-name 'commit))
   (:method :around ((conn dbi-connection))
@@ -335,7 +371,7 @@ This method must be implemented in each drivers.")
 (defgeneric rollback (conn)
   (:documentation "Rollback all changes and end the current transaction.")
   (:method ((conn dbi-connection))
-    (declare (ignore conn))
+    (declare (ignore conn state))
     (error 'dbi-notsupported-error
            :method-name 'rollback))
   (:method :around ((conn dbi-connection))
@@ -382,7 +418,7 @@ This method must be implemented in each drivers.")
 
 (defgeneric release-savepoint (conn &optional identifier)
   (:method ((conn dbi-connection) &optional identifier)
-    (do-sql conn (format nil "RELEASE ~A" identifier)))
+    (do-sql conn (format nil "RELEASE SAVEPOINT ~A" identifier)))
 
   (:method :around ((conn dbi-connection) &optional identifier)
     (finalize-savepoint :commited