X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Ftransaction.lisp;h=286839be9d3bb4d20d5e480be0393787d666ece5;hp=0b2b63d510a3ff66f679b7f3d86678caffb65c5b;hb=e622ee6f4bf2b9fe81af59d566e651c983a4833b;hpb=8a8ee2d7d791b7a3efaed06420802a925d16fca3 diff --git a/sql/transaction.lisp b/sql/transaction.lisp index 0b2b63d..286839b 100644 --- a/sql/transaction.lisp +++ b/sql/transaction.lisp @@ -32,8 +32,7 @@ (when (transaction database) (push rollback-hook (rollback-hooks (transaction database))))) -(defmethod database-start-transaction (database) - (unless database (error 'clsql-no-database-error)) +(defmethod database-start-transaction ((database database)) (unless (transaction database) (setf (transaction database) (make-instance 'transaction))) (when (= (incf (transaction-level database) 1)) @@ -43,31 +42,31 @@ (transaction-status transaction) nil) (execute-command "BEGIN" :database database)))) -(defmethod database-commit-transaction (database) +(defmethod database-commit-transaction ((database database)) (if (> (transaction-level database) 0) (when (zerop (decf (transaction-level database))) (execute-command "COMMIT" :database database) (map nil #'funcall (commit-hooks (transaction database)))) - (warn 'clsql-simple-warning + (warn 'sql-warning :format-control "Cannot commit transaction against ~A because there is no transaction in progress." :format-arguments (list database)))) -(defmethod database-abort-transaction (database) +(defmethod database-abort-transaction ((database database)) (if (> (transaction-level database) 0) (when (zerop (decf (transaction-level database))) (unwind-protect (execute-command "ROLLBACK" :database database) (map nil #'funcall (rollback-hooks (transaction database))))) - (warn 'clsql-simple-warning + (warn 'sql-warning :format-control "Cannot abort transaction against ~A because there is no transaction in progress." :format-arguments (list database)))) (defmacro with-transaction ((&key (database '*default-database*)) &rest body) - "Executes BODY within a transaction for DATABASE (which defaults to -*DEFAULT-DATABASE*). The transaction is committed if the body finishes -successfully (without aborting or throwing), otherwise the database is -rolled back." + "Starts a transaction in the database specified by DATABASE, +which is *DEFAULT-DATABASE* by default, and executes BODY within +that transaction. If BODY aborts or throws, DATABASE is rolled +back and otherwise the transaction is committed." (let ((db (gensym "db-"))) `(let ((,db ,database)) (unwind-protect @@ -80,23 +79,26 @@ rolled back." (database-abort-transaction ,db)))))) (defun commit (&key (database *default-database*)) - "Commits changes made to DATABASE which defaults to *DEFAULT-DATABASE*." + "If DATABASE, which defaults to *DEFAULT-DATABASE*, is +currently within the scope of a transaction, commits changes made +since the transaction began." (database-commit-transaction database)) (defun rollback (&key (database *default-database*)) - "Rolls back changes made in DATABASE, which defaults to -*DEFAULT-DATABASE* since the last commit, that is changes made since -the last commit are not recorded." + "If DATABASE, which defaults to *DEFAULT-DATABASE*, is +currently within the scope of a transaction, rolls back changes +made since the transaction began." (database-abort-transaction database)) (defun start-transaction (&key (database *default-database*)) "Starts a transaction block on DATABASE which defaults to -*default-database* and which continues until ROLLBACK or COMMIT are -called." +*DEFAULT-DATABASE* and which continues until ROLLBACK or COMMIT +are called." (unless (in-transaction-p :database database) (database-start-transaction database))) (defun in-transaction-p (&key (database *default-database*)) - "A predicate to test whether we are currently within the scope of a -transaction in DATABASE." + "A predicate to test whether DATABASE, which defaults to +*DEFAULT-DATABASE*, is currently within the scope of a +transaction." (and database (transaction database) (= (transaction-level database) 1)))