diff --git a/src/dbd/postgres.lisp b/src/dbd/postgres.lisp index 987d413..8593048 100644 --- a/src/dbd/postgres.lisp +++ b/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)) diff --git a/src/dbd/sqlite3.lisp b/src/dbd/sqlite3.lisp index 3817e52..ede4766 100644 --- a/src/dbd/sqlite3.lisp +++ b/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)) diff --git a/src/dbi.lisp b/src/dbi.lisp index 5341707..6f85390 100644 --- a/src/dbi.lisp +++ b/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 diff --git a/src/driver.lisp b/src/driver.lisp index 75aa346..82a1862 100644 --- a/src/driver.lisp +++ b/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,10 +281,10 @@ 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) @@ -272,6 +292,7 @@ This method must be implemented in each drivers.") (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