add save-dao/transaction, since the old version would emit warnings inside of transactions
Tue Mar 9 02:12:06 PST 2010 marijnh@gmail.com
* add save-dao/transaction, since the old version would emit warnings inside of transactions
Warning: CRC errors found. These are probably harmless but should be repaired.
See 'darcs gzcrcs --help' for more information.
diff -rN -u old-postmodern/doc/postmodern.html new-postmodern/doc/postmodern.html
--- old-postmodern/doc/postmodern.html 2014-07-13 15:08:23.000000000 -0700
+++ new-postmodern/doc/postmodern.html 2014-07-13 15:08:23.000000000 -0700
@@ -652,7 +652,7 @@
error when no row matching the DAO exists.</p>
<p class="def">
- <span>method</span>
+ <span>function</span>
<a name="save-dao"></a>
save-dao (dao)
<br/>&#8594; boolean
@@ -667,6 +667,24 @@
fails as well. Returns a boolean telling you whether a new row was
inserted.</p>
+ <p class="desc">This function is unsafe to use inside of a
+ transaction &#x2015; when a row with the given keys already
+ exists, the transaction will be abandoned. Use <a
+ href="#save-dao/transaction"><code>save-dao/transaction</code></a>
+ instead in such a situation.</p>
+
+ <p class="def">
+ <span>function</span>
+ <a name="save-dao/transaction"></a>
+ save-dao/transaction (dao)
+ <br/>&#8594; boolean
+ </p>
+
+ <p class="desc">Acts exactly like <a
+ href="#save-dao"><code>save-dao</code></a>, except that it
+ protects its attempt to insert the object with a rollback point,
+ so that a failure will not abort the transaction.</p>
+
<p class="def">
<span>method</span>
<a name="delete-dao"></a>
@@ -875,6 +893,7 @@
<li><a href="#reset-table">reset-table</a></li>
<li><a href="#rollback-savepoint">rollback-savepoint</a></li>
<li><a href="#save-dao">save-dao</a></li>
+ <li><a href="#save-dao/transaction">save-dao/transaction</a></li>
<li><a href="#select-dao">select-dao</a></li>
<li><a href="#sequence-exists-p">sequence-exists-p</a></li>
<li><a href="#sequence-next">sequence-next</a></li>
diff -rN -u old-postmodern/postmodern/package.lisp new-postmodern/postmodern/package.lisp
--- old-postmodern/postmodern/package.lisp 2014-07-13 15:08:23.000000000 -0700
+++ new-postmodern/postmodern/package.lisp 2014-07-13 15:08:23.000000000 -0700
@@ -8,7 +8,7 @@
(:export
#:dao-class #:dao-exists-p #:dao-keys #:query-dao #:select-dao #:get-dao
#:with-column-writers
- #:insert-dao #:update-dao #:save-dao #:delete-dao
+ #:insert-dao #:update-dao #:save-dao #:save-dao/transaction #:delete-dao
#:dao-table-name #:dao-table-definition
#:\!dao-def)
diff -rN -u old-postmodern/postmodern/table.lisp new-postmodern/postmodern/table.lisp
--- old-postmodern/postmodern/table.lisp 2014-07-13 15:08:23.000000000 -0700
+++ new-postmodern/postmodern/table.lisp 2014-07-13 15:08:23.000000000 -0700
@@ -270,7 +270,13 @@
(defun save-dao (dao)
"Try to insert the content of a DAO. If this leads to a unique key
violation, update it instead."
- (handler-case (with-transaction () (insert-dao dao) t)
+ (handler-case (progn (insert-dao dao) t)
+ (cl-postgres-error:unique-violation ()
+ (update-dao dao)
+ nil)))
+
+(defun save-dao/transaction (dao)
+ (handler-case (with-savepoint save-dao/transaction (insert-dao dao) t)
(cl-postgres-error:unique-violation ()
(update-dao dao)
nil)))
diff -rN -u old-postmodern/postmodern/tests.lisp new-postmodern/postmodern/tests.lisp
--- old-postmodern/postmodern/tests.lisp 2014-07-13 15:08:23.000000000 -0700
+++ new-postmodern/postmodern/tests.lisp 2014-07-13 15:08:23.000000000 -0700
@@ -153,6 +153,20 @@
(is (not (select-dao 'test-data)))
(execute (:drop-table 'dao-test))))
+(test save-dao
+ (with-test-connection
+ (execute (dao-table-definition 'test-data))
+ (let ((dao (make-instance 'test-data :a "quux")))
+ (is (save-dao dao))
+ (setf (test-a dao) "bar")
+ (is (not (save-dao dao)))
+ (is (equal (test-a (get-dao 'test-data (test-id dao))) "bar"))
+ (signals database-error
+ (with-transaction () (save-dao dao)))
+ (with-transaction ()
+ (is (not (save-dao/transaction dao)))))
+ (execute (:drop-table 'dao-test))))
+
(defclass test-oid ()
((oid :col-type integer :ghost t :accessor test-oid)
(a :col-type string :initarg :a :accessor test-a)