Add do-cursor.

src/core/dao.lisp

@@ -63,7 +63,8 @@
            #:count-dao
            #:recreate-table
            #:ensure-table-exists
-           #:deftable))
+           #:deftable
+           #:do-cursor))
 (in-package #:mito.dao)
 
 (defun foreign-value (obj slot)
@@ -448,3 +449,17 @@
      ,@(unless (find :conc-name options :key #'car)
                `((:conc-name ,(intern (format nil "~@:(~A-~)" name) (symbol-package name)))))
      ,@options))
+
+(defmacro do-cursor ((dao select &optional index) &body body)
+  (with-gensyms (main cursor)
+    `(flet ((,main ()
+              (let* ((*want-cursor* t)
+                     (,cursor ,select))
+                (loop ,@(and index `(for ,index from 0))
+                      for ,dao = (fetch-dao ,cursor)
+                      while ,dao
+                      do (progn ,@body)))))
+       (if (dbi:in-transaction *connection*)
+           (,main)
+           (dbi:with-transaction *connection*
+             (,main))))))

t/dao.lisp

@@ -268,6 +268,17 @@
         (ok (typep row 'user))
         (ok (equal (slot-value row 'name) "Btaro")))
       (ok (null (mito.dao:fetch-dao cursor)))))
+
+  (let ((records '()))
+    (do-cursor (dao (mito.dao:select-dao 'user) i)
+      (push (cons i dao) records)
+      (when (<= 1 i)
+        (return)))
+    (ok (= (length records) 2))
+    (ok (every (lambda (record)
+                 (typep (cdr record) 'user))
+               records)))
+
   (when (find-class 'user nil)
     (setf (find-class 'user) nil))
   (disconnect-toplevel))