+(defun select-reference-equal (r1 r2)
+ "determines if two sql select references are equal
+ using database identifier equal"
+ (flet ((id-of (r)
+ (etypecase r
+ (cons (cdr r))
+ (sql-ident-attribute r))))
+ (database-identifier-equal (id-of r1) (id-of r2))))
+
+(defun join-slot-qualifier (class join-slot)
+ "Creates a sql-expression expressing the join between the home-key on the table
+ and its respective key on the joined-to-table"
+ (sql-operation
+ '==
+ (sql-expression
+ :attribute (join-slot-info-value join-slot :foreign-key)
+ :table (view-table (join-slot-class join-slot)))
+ (sql-expression
+ :attribute (join-slot-info-value join-slot :home-key)
+ :table (view-table class))))
+
+(defun all-immediate-join-classes-for (classes)
+ "returns a list of all join-classes needed for a list of classes"
+ (loop for class in (listify classes)
+ appending (loop for slot in (immediate-join-slots class)
+ collect (join-slot-class slot))))
+
+(defun %tables-for-query (classes from where inner-joins)
+ "Given lists of classes froms wheres and inner-join compile a list
+ of tables that should appear in the FROM section of the query.
+
+ This includes any immediate join classes from each of the classes"
+ (let ((inner-join-tables (collect-table-refs (listify inner-joins))))
+ (loop for tbl in (append
+ (mapcar #'select-table-sql-expr classes)
+ (mapcar #'select-table-sql-expr
+ (all-immediate-join-classes-for classes))
+ (collect-table-refs (listify where))
+ (collect-table-refs (listify from)))
+ when (and tbl
+ (not (find tbl rtn :test #'database-identifier-equal))
+ ;; TODO: inner-join is currently hacky as can be
+ (not (find tbl inner-join-tables :test #'database-identifier-equal)))
+ collect tbl into rtn
+ finally (return rtn))))
+
+(defun full-select-list ( classes )
+ "Returns a list of sql-ref of things to select for the given classes
+
+ THIS NEEDS TO MATCH THE ORDER OF build-objects
+
+ TODO: this used to include order-by and distinct as more things to select.
+ distinct seems to always be used in a boolean context, so it doesnt seem
+ like appending it to the select makes any sense
+
+ We also used to remove duplicates, but that seems like it would make
+ filling/building objects much more difficult so skipping for now...
+ "
+ (setf classes (mapcar #'to-class (listify classes)))
+ (mapcar
+ #'cdr
+ (loop for class in classes
+ appending (generate-selection-list class)
+ appending
+ (loop for join-slot in (immediate-join-slots class)
+ for join-class = (join-slot-class-name join-slot)
+ appending (generate-selection-list join-class)))))
+
+(defun build-objects (classes row database &optional existing-instances)
+ "Used by find-all to build objects.
+
+ THIS NEEDS TO MATCH THE ORDER OF FULL-SELECT-LIST
+
+ TODO: this caching scheme seems bad for a number of reasons
+ * order is not guaranteed so references being held by one object
+ might change to represent a different database row (seems HIGHLY
+ suspect)
+ * also join objects are overwritten rather than refreshed
+
+ TODO: the way we handle immediate joins seems only valid if it is a single
+ object. I suspect that making a :set :immediate join column would result
+ in an invalid number of objects returned from the database, because there
+ would be multiple rows per object, but we would return an object per row
+ "
+ (setf existing-instances (listify existing-instances))
+ (loop for class in classes
+ for existing = (pop existing-instances)
+ for object = (or existing
+ (make-instance class :view-database database))
+ do (loop for (slot . _) in (generate-selection-list class)
+ do (update-slot-from-db-value object slot (pop row)))
+ do (loop for join-slot in (immediate-join-slots class)
+ for join-class = (join-slot-class-name join-slot)
+ for join-object =
+ (setf
+ (easy-slot-value object join-slot)
+ (make-instance join-class))
+ do (loop for (slot . _) in (generate-selection-list join-class)
+ do (update-slot-from-db-value join-object slot (pop row))))
+ do (when existing (instance-refreshed object))
+ collect object))