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))