Re: [CLSQL-Help] Bug in 'update-records-from-instance' (draft patch)
Nathan Bird <[email protected]> Tue, 12 Jun 2007 18:47:28 -0400
| Newsgroups | gmane.lisp.clsql.devel |
|---|---|
| Message-ID | <[email protected]> |
This is a multi-part message in MIME format.
--------------040502030203030005030101
Content-Type: text/html; charset=ISO-8859-1
Content-Transfer-Encoding: 7bit
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type">
</head>
<body bgcolor="#ffffff" text="#000000">
Saurabh Nanda wrote:
<blockquote
cite="mid:794f042d0706110221y24471160wbb52ad7fc06c0777-JsoAwUIsXosN+BqQ9rBEUg@public.gmane.org"
type="cite">
<blockquote type="cite">
<pre wrap="">Second, to accomodate your desire to take an object and store in (and
presumably you also want to associate that object with) a different
database, then a new function can be added that explicitly breaks the
existing database-object binding. Something like:
</pre>
</blockquote>
<pre wrap=""><!---->
Kevin, the intent is not to associate an object with a different
_database_, but with a different _database connection_ This kind of
thing becomes very common when one is writing "standalone" functions
to operate on objects mapped to databases. For example,
</pre>
</blockquote>
This is exactly the case I have, transient connections to the same
database. Maybe trying to add logic for reopening the database to my
application is a better solution... I will think more on that one as
well. The model I'm used to from other languages/frameworks is for
short lived connection objects that are interchangeable. Either way the
goal of this patch was to allow us to dance around the issue without
causing any big changes. <br>
<br>
Here is a draft patch for pulling out a choose-database-for-instance.
Note that this doesn't need to change the semantics away from the
commonSql spec. The key being that the logic for it is now isolated in
an easily overridable method. CLSQL can continue to be distributed
according to the spec with this as an easy point to customize the
behavior as our different uses demand.<br>
<br>
The patch as submitted does make two changes: delete-instance-records
now has an &key database (with same semantics as all the others),
and the database is selected on being open, not just being existent. <br>
<br>
Additionally I refactored update-record-from-instance to call
update-record-from-slots. The two functions were practically identical,
the changes minor.<br>
<br>
This patch does not fix any of the documentation strings to match. I
will make a pass through all of those if you are interested in
including this, but if not I don't want to waste time increasing the
amount I have to merge on the next release.<br>
<br>
This gives me the same set of failing tests (for odbc, I ran the tests
on mysql and postrgesql-socket and I don't think there are regressions
there, but only examined cursorily), I have some other patches I'm
working on that should help in a few of those cases.<br>
<br>
Any comments?<br>
<br>
Nathan Bird<br>
<br>
</body>
</html>
--------------040502030203030005030101
Content-Type: text/plain;
name="choose-database-for-instance.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="choose-database-for-instance.patch"
Tue Jun 12 17:51:57 EDT 2007 Nathan Bird <[email protected]>
* 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 refactored update-record-from-instance to call update-record-from-slots.
diff -rN -u old-clsql/sql/generics.lisp new-clsql/sql/generics.lisp
--- old-clsql/sql/generics.lisp 2007-06-12 18:09:56.000000000 -0400
+++ new-clsql/sql/generics.lisp 2007-06-12 18:09:56.000000000 -0400
@@ -48,7 +48,14 @@
elements of a list."))
-;; OODML
+;; OODML
+
+(defgeneric choose-database-for-instance (object 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 update-record-from-slot (object slot &key database)
(:documentation
@@ -84,7 +91,7 @@
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 -rN -u old-clsql/sql/oodml.lisp new-clsql/sql/oodml.lisp
--- old-clsql/sql/oodml.lisp 2007-06-12 18:09:56.000000000 -0400
+++ new-clsql/sql/oodml.lisp 2007-06-12 18:09:56.000000000 -0400
@@ -158,9 +158,19 @@
(mapc #'update-slot slotdeflist values)
obj))
-(defmethod update-record-from-slot ((obj standard-db-object) slot &key
- (database *default-database*))
- (let* ((database (or (view-database obj) database))
+(defmethod choose-database-for-instance ((obj standard-db-object) 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)))
+
+(defmethod update-record-from-slot ((obj standard-db-object) slot
+ &key database)
+ (let* ((database (choose-database-for-instance obj database))
(vct (view-table (class-of obj)))
(sd (slotdef-for-slot-with-class slot (class-of obj))))
(check-slot-type sd (slot-value obj slot))
@@ -183,19 +193,23 @@
(error "Unable to update record.")))))
(values))
-(defmethod update-record-from-slots ((obj standard-db-object) slots &key
- (database *default-database*))
- (let* ((database (or (view-database obj) database))
+
+(defmethod update-record-from-slots ((obj standard-db-object) slots
+ &key 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)))
+ (view-class (class-of obj))
(avps (mapcar #'(lambda (s)
- (let ((val (slot-value
- obj (slot-definition-name s))))
- (check-slot-type s val)
+ (let* ((slot (etypecase s
+ (symbol (slotdef-for-slot-with-class s view-class))
+ (view-class-effective-slot-definition s)))
+ (val (slot-value
+ obj (slot-definition-name slot))))
+ (check-slot-type slot val)
(list (sql-expression
- :attribute (view-class-slot-column s))
- (db-value-from-slot s val database))))
- sds)))
+ :attribute (view-class-slot-column slot))
+ (db-value-from-slot slot val database))))
+ slots)))
(cond ((and avps (view-database obj))
(update-records (sql-expression :table vct)
:av-pairs avps
@@ -212,67 +226,46 @@
(values))
(defmethod update-records-from-instance ((obj standard-db-object) &key database)
- (let ((database (or database (view-database obj) *default-database*)))
- (labels ((slot-storedp (slot)
- (and (member (view-class-slot-db-kind slot) '(:base :key))
- (slot-boundp obj (slot-definition-name slot))))
- (slot-value-list (slot)
- (let ((value (slot-value obj (slot-definition-name slot))))
- (check-slot-type slot value)
- (list (sql-expression :attribute (view-class-slot-column slot))
- (db-value-from-slot slot value database)))))
- (let* ((view-class (class-of obj))
- (view-class-table (view-table view-class))
- (slots (remove-if-not #'slot-storedp
- (ordered-class-slots view-class)))
- (record-values (mapcar #'slot-value-list slots)))
- (unless record-values
- (error "No settable slots."))
- (if (view-database obj)
- (update-records (sql-expression :table view-class-table)
- :av-pairs record-values
- :where (key-qualifier-for-instance
- obj :database database)
- :database database)
- (progn
- (insert-records :into (sql-expression :table view-class-table)
- :av-pairs record-values
- :database database)
- (setf (slot-value obj 'view-database) database))))))
- (values))
+ (labels ((slot-storedp (slot)
+ (and (member (view-class-slot-db-kind slot) '(:base :key))
+ (slot-boundp obj (slot-definition-name slot)))))
+ (let* ((view-class (class-of obj))
+ (slots (remove-if-not #'slot-storedp
+ (ordered-class-slots view-class))))
+ (update-record-from-slots obj slots :database database )))
+ )
-(defmethod delete-instance-records ((instance standard-db-object))
+(defmethod delete-instance-records ((instance standard-db-object) &key database)
(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)
- (setf (slot-value instance 'view-database) nil)
- (values))
- (signal-no-database-error vd))))
+ (database (choose-database-for-instance instance 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))))
(defmethod update-instance-from-records ((instance standard-db-object)
- &key (database *default-database*))
+ &key database)
(let* ((view-class (find-class (class-name (class-of instance))))
(view-table (sql-expression :table (view-table view-class)))
- (vd (or (view-database instance) database))
- (view-qual (key-qualifier-for-instance instance :database vd))
+ (database (choose-database-for-instance instance database))
+ (view-qual (key-qualifier-for-instance instance :database database))
(sels (generate-selection-list view-class))
(res (apply #'select (append (mapcar #'cdr sels)
(list :from view-table
:where view-qual
:result-types nil
- :database vd)))))
+ :database database)))))
(when res
(get-slot-values-from-view instance (mapcar #'car sels) (car res)))))
(defmethod update-slot-from-record ((instance standard-db-object)
- slot &key (database *default-database*))
+ slot &key database)
(let* ((view-class (find-class (class-name (class-of instance))))
(view-table (sql-expression :table (view-table view-class)))
- (vd (or (view-database instance) database))
- (view-qual (key-qualifier-for-instance instance :database vd))
+ (database (choose-database-for-instance instance database))
+ (view-qual (key-qualifier-for-instance instance :database database))
(slot-def (slotdef-for-slot-with-class slot view-class))
(att-ref (generate-attribute-reference view-class slot-def))
(res (select att-ref :from view-table :where view-qual
--------------040502030203030005030101
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline
_______________________________________________
CLSQL-Devel mailing list
[email protected]
http://lists.b9.com/mailman/listinfo/clsql-devel
--------------040502030203030005030101--