X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fooddl.lisp;h=50c37a691a7639ad1c48fdfe71d6f4c1848e4a8b;hp=9fb218fa3164ddbd87ddf886b43d29abafa8458e;hb=534849c88501e0ea2ee5dbf78d13d8cb73814d71;hpb=47d5ae2b1454553fa6d71c08862c7dfc5df97a92 diff --git a/sql/ooddl.lisp b/sql/ooddl.lisp index 9fb218f..50c37a6 100644 --- a/sql/ooddl.lisp +++ b/sql/ooddl.lisp @@ -31,32 +31,33 @@ (defvar *db-initializing* nil) (defmethod slot-value-using-class ((class standard-db-class) instance slot-def) + "When a slot is unbound but should contain a join object or a value from a + normalized view-class, then retrieve and set those slots, so the value can + be returned" (declare (optimize (speed 3))) (unless *db-deserializing* (let* ((slot-name (%svuc-slot-name slot-def)) - (slot-object (%svuc-slot-object slot-def class)) - (slot-kind (view-class-slot-db-kind slot-object))) - (if (and (eql slot-kind :join) - (not (slot-boundp instance slot-name))) - (let ((*db-deserializing* t)) - (if (view-database instance) - (setf (slot-value instance slot-name) - (fault-join-slot class instance slot-object)) - (setf (slot-value instance slot-name) nil))) - (when (and (normalizedp class) - (not (member slot-name - (mapcar #'(lambda (esd) (slot-definition-name esd)) - (ordered-class-direct-slots class)))) - (not (slot-boundp instance slot-name))) - (let ((*db-deserializing* t)) - (if (view-database instance) - (setf (slot-value instance slot-name) - (fault-join-normalized-slot class instance slot-object)) - (setf (slot-value instance slot-name) nil))))))) + (slot-object (%svuc-slot-object slot-def class))) + (unless (slot-boundp instance slot-name) + (let ((*db-deserializing* t)) + (cond + ((join-slot-p slot-def) + (setf (slot-value instance slot-name) + (if (view-database instance) + (fault-join-slot class instance slot-object) + ;; TODO: you could in theory get a join object even if + ;; its joined-to object was not in the database + nil + ))) + ((not-direct-normalized-slot-p class slot-def) + (if (view-database instance) + (update-fault-join-normalized-slot class instance slot-def) + (setf (slot-value instance slot-name) nil)))))))) (call-next-method)) (defmethod (setf slot-value-using-class) (new-value (class standard-db-class) instance slot-def) + "Handle auto syncing values to the database if *db-auto-sync* is t" (declare (ignore new-value)) (let* ((slot-name (%svuc-slot-name slot-def)) (slot-object (%svuc-slot-object slot-def class)) @@ -137,7 +138,7 @@ in DATABASE which defaults to *DEFAULT-DATABASE*." (defmethod database-generate-column-definition (class slotdef database) (declare (ignore class)) - (when (member (view-class-slot-db-kind slotdef) '(:base :key)) + (when (key-or-base-slot-p slotdef) (let ((cdef (list (sql-expression :attribute (database-identifier slotdef database)) (specified-type slotdef))))