From 7b4794147500df7188fef2fe4f5e16d05d552ffd Mon Sep 17 00:00:00 2001 From: Nathan Bird Date: Tue, 12 Jun 2007 17:51:57 -0400 Subject: [PATCH] Refactorng choose-database-for-instance method out. This function encapsulates the logic about which database connection to use and is called by most of the update-*-from-* in the oodml functions. Also allows overriding to control object connection management (which is nice in heavily multithreaded (web) environs) * f10fc333da09ea7e24477e6199ffbc541adff2f1 * 348cafca35b850b66b1181ba0661211e64f0d4f1 --- sql/generics.lisp | 7 +++++- sql/oodml.lisp | 57 +++++++++++++++++++++++++++++------------------ 2 files changed, 41 insertions(+), 23 deletions(-) diff --git a/sql/generics.lisp b/sql/generics.lisp index b0a4472..3f3ee7c 100644 --- a/sql/generics.lisp +++ b/sql/generics.lisp @@ -18,6 +18,11 @@ ;; FDML +(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 + or the *DEFAULT-DATABASE*.")) (defgeneric execute-command (expression &key database) (:documentation @@ -82,7 +87,7 @@ case, a record is created in the appropriate table of DATABASE using values from the slot values of OBJECT, and OBJECT becomes associated with DATABASE.")) -(defgeneric delete-instance-records (object) +(defgeneric delete-instance-records (object &key database) (:documentation "Deletes the records represented by OBJECT in the appropriate table of the database associated with OBJECT. If OBJECT is not diff --git a/sql/oodml.lisp b/sql/oodml.lisp index b2f16a6..ec54a34 100644 --- a/sql/oodml.lisp +++ b/sql/oodml.lisp @@ -93,6 +93,17 @@ (push (cons slotdef res) sels)))))) sels)) +(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) + (and db (is-database-open db))) + (list (view-database obj) + database + *default-database*)) + (signal-no-database-error nil))) + + ;; Called by 'get-slot-values-from-view' ;; @@ -105,9 +116,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) @@ -170,7 +181,7 @@ (defmethod update-record-from-slot ((obj standard-db-object) slot &key (database *default-database*)) - (let* ((database (or (view-database obj) database)) + (let* ((database (choose-database-for-instance obj database)) (view-class (class-of obj))) (when (normalizedp view-class) ;; If it's normalized, find the class that actually contains @@ -213,7 +224,7 @@ (update-record-from-slot obj slot :database database)) (return-from update-record-from-slots (values))) - (let* ((database (or (view-database obj) database)) + (let* ((database (choose-database-for-instance obj database)) (vct (view-table (class-of obj))) (sds (slotdefs-for-slots-with-class slots (class-of obj))) (avps (mapcar #'(lambda (s) @@ -244,7 +255,7 @@ (defmethod update-records-from-instance ((obj standard-db-object) &key database this-class) - (let ((database (or database (view-database obj) *default-database*)) + (let ((database (choose-database-for-instance obj database)) (pk nil)) (labels ((slot-storedp (slot) (and (member (view-class-slot-db-kind slot) '(:base :key)) @@ -276,6 +287,8 @@ (not record-values)) nil) ((view-database obj) + ;; if this slot is set, the database object was returned from a select + ;; and has already been in the database, so we must need an update (update-records (sql-expression :table view-class-table) :av-pairs record-values :where (key-qualifier-for-instance @@ -318,16 +331,16 @@ pk)) -(defmethod delete-instance-records ((instance standard-db-object)) - (let ((vt (sql-expression :table (view-table (class-of instance)))) - (vd (view-database instance))) - (if vd - (let ((qualifier (key-qualifier-for-instance instance :database vd))) - (delete-records :from vt :where qualifier :database vd) - (setf (record-caches vd) nil) +(defmethod delete-instance-records ((instance standard-db-object) &key database) + (let ((database (choose-database-for-instance instance database)) + (vt (sql-expression :table (view-table (class-of instance))))) + (if database + (let ((qualifier (key-qualifier-for-instance instance :database database))) + (delete-records :from vt :where qualifier :database database) + (setf (record-caches database) nil) (setf (slot-value instance 'view-database) nil) (values)) - (signal-no-database-error vd)))) + (signal-no-database-error database)))) (defmethod update-instance-from-records ((instance standard-db-object) &key (database *default-database*) @@ -339,7 +352,7 @@ (setf pres (update-instance-from-records instance :database database :this-class pclass))) (let* ((view-table (sql-expression :table (view-table view-class))) - (vd (or (view-database instance) database)) + (vd (choose-database-for-instance instance database)) (view-qual (key-qualifier-for-instance instance :database vd :this-class view-class)) (sels (generate-selection-list view-class)) @@ -371,7 +384,7 @@ (ordered-class-direct-slots this-class))) this-class)))) (let* ((view-table (sql-expression :table (view-table view-class))) - (vd (or (view-database instance) database)) + (vd (choose-database-for-instance instance database)) (view-qual (key-qualifier-for-instance instance :database vd :this-class view-class)) (att-ref (generate-attribute-reference view-class slot-def)) @@ -770,10 +783,10 @@ :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 instance)))) (setf (slot-value jcc (gethash :foreign-key dbi)) key) (setf (slot-value jcc (gethash :home-key tdbi)) @@ -784,8 +797,8 @@ ;; 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)) @@ -796,7 +809,7 @@ (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 @@ -894,7 +907,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)) @@ -943,7 +956,7 @@ maximum of MAX-LEN instances updated in each query." (let ((res (car (select (class-name sc) :where jq :flatp t :result-types nil :caching nil - :database (view-database object)))) + :database (choose-database-for-instance object)))) (slot-name (slot-definition-name slot-def))) ;; If current class is normalized and wanted slot is not -- 2.34.1