darcs patch:
authornathan@acceleration.net <nathan@acceleration.net>
Fri, 22 Feb 2008 22:01:46 +0000 (17:01 -0500)
committerNathan Bird <nathan@acceleration.net>
Mon, 2 Feb 2009 20:18:16 +0000 (15:18 -0500)
Thu Aug 23 17:16:31 EDT 2007  Russ Tyndall <russ@acceleration.net>
  * Changed many more instances of view-database to choose-database (so that joins work)

plus a couple of other references to the view-database i found.

sql/generics.lisp
sql/oodml.lisp

index 0814d0f2674d1bdf556c6bd4f0e128107daa0baa..d0d69d3444a404494e94d3da9e067e236473f8ae 100644 (file)
@@ -21,7 +21,7 @@
 
 ;; FDML
 
-(defgeneric choose-database-for-instance (object database)
+(defgeneric choose-database-for-instance (object &optional database)
   (:documentation "Used by the oodml functions to select which
  database object to use. Chooses the database associated with the
  object primarily, falls back to the database provided as an argument
index b5a5907176bb44646287d2eef2bb2663e64f64b3..30f6b0dfd82ea20aaab3526dcca657a8740f0a08 100644 (file)
@@ -95,9 +95,9 @@
     (cond ((and value (null slot-reader))
            (setf (slot-value instance slot-name)
                  (read-sql-value value (delistify slot-type)
-                                 (view-database instance)
+                                (choose-database-for-instance instance)
                                  (database-underlying-type
-                                  (view-database instance)))))
+                                  (choose-database-for-instance instance)))))
           ((null value)
            (update-slot-with-null instance slot-name slotdef))
           ((typep slot-reader 'string)
       (mapc #'update-slot slotdeflist values)
       obj))
 
-(defmethod choose-database-for-instance ((obj standard-db-object) database)
+(defmethod choose-database-for-instance ((obj standard-db-object) &optional database)
   "Determine which database connection to use for a standard-db-object.
         Errs if none is available."
   (or (find-if #'(lambda (db)
                                 :table jc-view-table))
                           :where jq
                           :result-types :auto
-                          :database (view-database object))))
+                          :database (choose-database-for-instance object))))
            (mapcar #'(lambda (i)
                        (let* ((instance (car i))
-                              (jcc (make-instance jc :view-database (view-database instance))))
+                              (jcc (make-instance jc :view-database (choose-database-for-instance object))))
                          (setf (slot-value jcc (gethash :foreign-key dbi))
                                key)
                          (setf (slot-value jcc (gethash :home-key tdbi))
             ;; just fill in minimal slots
             (mapcar
              #'(lambda (k)
-                 (let ((instance (make-instance tsc :view-database (view-database object)))
-                       (jcc (make-instance jc :view-database (view-database object)))
+                 (let ((instance (make-instance tsc :view-database (choose-database-for-instance object)))
+                       (jcc (make-instance jc :view-database (choose-database-for-instance object)))
                        (fk (car k)))
                    (setf (slot-value instance (gethash :home-key tdbi)) fk)
                    (setf (slot-value jcc (gethash :foreign-key dbi))
              (select (sql-expression :attribute (gethash :foreign-key tdbi) :table jc-view-table)
                      :from (sql-expression :table jc-view-table)
                      :where jq
-                     :database (view-database object))))))))
+                     :database (choose-database-for-instance object))))))))
 
 
 ;;; Remote Joins
@@ -749,7 +749,7 @@ maximum of MAX-LEN instances updated in each query."
     (let ((jq (join-qualifier class object slot-def)))
       (when jq
         (select jc :where jq :flatp t :result-types nil
-                :database (view-database object))))))
+                :database (choose-database-for-instance object))))))
 
 (defun fault-join-slot (class object slot-def)
   (let* ((dbi (view-class-slot-db-info slot-def))