+(defun build-objects (vals sclasses immediate-join-classes sels immediate-joins database refresh flatp)
+ "Used by find-all to build objects."
+ (labels ((build-object (vals vclass jclasses selects immediate-selects)
+ (let* ((class-name (class-name vclass))
+ (db-vals (butlast vals (- (list-length vals)
+ (list-length selects))))
+ (join-vals (subseq vals (list-length selects)))
+ (obj (make-instance class-name :view-database database))
+ (joins (mapcar #'(lambda (c) (when c (make-instance c :view-database database)))
+ jclasses)))
+ ;;(format t "db-vals: ~S, join-values: ~S~%" db-vals join-vals)
+ ;; use refresh keyword here
+ (setf obj (get-slot-values-from-view obj (mapcar #'car selects)
+ db-vals))
+ (mapc #'(lambda (jc) (get-slot-values-from-view jc (mapcar #'car immediate-selects) join-vals))
+ joins)
+ (mapc
+ #'(lambda (jc) (let ((slot (find (class-name (class-of jc)) (class-slots vclass)
+ :key #'(lambda (slot) (when (and (eq :join (view-class-slot-db-kind slot))
+ (eq (slot-definition-name slot)
+ (gethash :join-class (view-class-slot-db-info slot))))
+ (slot-definition-name slot))))))
+ (when slot
+ (setf (slot-value obj (slot-definition-name slot)) jc))))
+
+ joins)
+ (when refresh (instance-refreshed obj))
+ obj)))
+ (let ((objects (mapcar #'(lambda (sclass jclass sel immediate-join)
+ (prog1 (build-object vals sclass jclass sel immediate-join)
+ (setf vals (nthcdr (+ (list-length sel) (list-length immediate-join))
+ vals))))
+ sclasses immediate-join-classes sels immediate-joins)))
+ (if (and flatp (= (length sclasses) 1))
+ (car objects)
+ objects))))
+