Improved documentation of normalized classes and changelog entry

[clsql.git] / sql / ooddl.lisp

diff --git a/sql/ooddl.lisp b/sql/ooddl.lisp
index 2d1d73b6252eda74e08881df79d12b2f59c259cb..50c37a691a7639ad1c48fdfe71d6f4c1848e4a8b 100644 (file)
--- 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))
@@ -106,9 +107,7 @@ in DATABASE which defaults to *DEFAULT-DATABASE*."
 (defmethod %install-class ((self standard-db-class) database
                            &key (transactions t))
   (let ((schemadef '())
-        (ordered-slots (if (normalizedp self)
-                           (ordered-class-direct-slots self)
-                           (ordered-class-slots self))))
+        (ordered-slots (slots-for-possibly-normalized-class self)))
     (dolist (slotdef ordered-slots)
       (let ((res (database-generate-column-definition self slotdef database)))
         (when res
@@ -139,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))))