X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Ftransaction.lisp;h=089ce0c2aa899147849a12e939be26b78b779c1a;hp=d41d6eff7c0f8a33d332a430af54ea617a382607;hb=33b80bc24835fb26d7a831e99aea3fb9a805b809;hpb=333e8280f2f3438ffd379349bc9746c34cccc159 diff --git a/sql/transaction.lisp b/sql/transaction.lisp index d41d6ef..089ce0c 100644 --- a/sql/transaction.lisp +++ b/sql/transaction.lisp @@ -22,11 +22,19 @@ (status :initform nil :accessor transaction-status :documentation "nil or :committed"))) -(defun add-transaction-commit-hook (database commit-hook) +(defun add-transaction-commit-hook (commit-hook &key + (database *default-database*)) + "Adds COMMIT-HOOK, which should a designator for a function +with no required arguments, to the list of hooks run when COMMIT +is called on DATABASE which defaults to *DEFAULT-DATABASE*." (when (transaction database) (push commit-hook (commit-hooks (transaction database))))) -(defun add-transaction-rollback-hook (database rollback-hook) +(defun add-transaction-rollback-hook (rollback-hook + &key (database *default-database*)) + "Adds ROLLBACK-HOOK, which should a designator for a function +with no required arguments, to the list of hooks run when ROLLBACK +is called on DATABASE which defaults to *DEFAULT-DATABASE*." (when (transaction database) (push rollback-hook (rollback-hooks (transaction database))))) @@ -52,9 +60,9 @@ (setf autocommit (previous-autocommit transaction)) (map nil #'funcall (commit-hooks transaction))) (warn 'sql-warning - :format-control - "Cannot commit transaction against ~A because there is no transaction in progress." - :format-arguments (list database))))) + :message + (format nil "Cannot commit transaction against ~A because there is no transaction in progress." + database))))) (defmethod database-abort-transaction ((database database)) (with-slots (transaction transaction-level autocommit) database @@ -65,9 +73,9 @@ (setf autocommit (previous-autocommit transaction)) (map nil #'funcall (rollback-hooks transaction)))) (warn 'sql-warning - :format-control - "Cannot abort transaction against ~A because there is no transaction in progress." - :format-arguments (list database))))) + :message + (format nil "Cannot abort transaction against ~A because there is no transaction in progress." + database))))) (defun mark-transaction-committed (database) (when (and (transaction database) @@ -82,9 +90,10 @@ back and otherwise the transaction is committed." (let ((db (gensym "db-"))) `(let ((,db ,database)) (unwind-protect - (progn + (prog2 (database-start-transaction ,db) - ,@body + (progn + ,@body) (mark-transaction-committed ,db)) (if (eq (transaction-status (transaction ,db)) :committed) (database-commit-transaction ,db) @@ -94,20 +103,23 @@ back and otherwise the transaction is committed." "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)) + (database-commit-transaction database) + nil) (defun rollback (&key (database *default-database*)) "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)) + (database-abort-transaction database) + nil) (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." (unless (in-transaction-p :database database) - (database-start-transaction database))) + (database-start-transaction database)) + nil) (defun in-transaction-p (&key (database *default-database*)) "A predicate to test whether DATABASE, which defaults to @@ -115,8 +127,15 @@ are called." transaction." (and database (transaction database) (= (transaction-level database) 1))) -(defun autocommit (&key (database *default-database*) (set :unspecified)) - "Returns whether autocommit is currently active." - (unless (eq set :unspecified) - (setf (database-autocommit database) set)) - (database-autocommit database)) +(defun set-autocommit (value &key (database *default-database*)) + "Turns autocommit off for DATABASE if VALUE is NIL, and +otherwise turns it on. Returns the old value of autocommit flag. +For RDBMS (such as Oracle) which don't automatically commit +changes, turning autocommit on has the effect of explicitly +committing changes made whenever SQL statements are executed. +Autocommit is turned on by default." + (let ((old-value (database-autocommit database))) + (setf (database-autocommit database) value) + (database-autocommit database) + old-value)) +