r10376: 03 Apr 2005 Kevin Rosenberg <kevin@rosenberg.net>

[clsql.git] / sql / transaction.lisp

diff --git a/sql/transaction.lisp b/sql/transaction.lisp
index d41d6eff7c0f8a33d332a430af54ea617a382607..089ce0c2aa899147849a12e939be26b78b779c1a 100644 (file)
--- 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))
+