diff --git a/src/core/dao.lisp b/src/core/dao.lisp index 6c4817b..546bf3a 100644 --- a/src/core/dao.lisp +++ b/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)))))) diff --git a/t/dao.lisp b/t/dao.lisp index cc0e257..2adb71d 100644 --- a/t/dao.lisp +++ b/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))