X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Foodml.lisp;fp=sql%2Foodml.lisp;h=78c1a4f23fde5a04cda28523353fac1a4094648b;hp=dbd5e6c5d1b2ba9db199d97f3cde08781c108969;hb=0b35694f3659e5ee739ea72ce74d798c3f0ddb73;hpb=c5114f6d1dd70197d14c94ac8b83c19016e76880;ds=sidebyside

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index dbd5e6c..78c1a4f 100644
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -219,19 +219,21 @@
 
 (defun update-auto-increments-keys (class obj database)
   " handle pulling any autoincrement values into the object
-   if normalized and we now that all the "
+    Also handles normalized key chaining"
   (let ((pk-slots (keyslots-for-class class))
         (table (view-table class))
         new-pk-value)
-    (labels ((do-update (slot)
-               (when (and (null (easy-slot-value obj slot))
-                          (auto-increment-column-p slot database))
-                 (update-slot-from-db-value
-                  obj slot
-                  (or new-pk-value
-                      (setf new-pk-value
-                            (database-last-auto-increment-id
-                             database table slot))))))
+    (labels ((do-update (slot &aux (val (easy-slot-value obj slot)))
+               (if val
+                   (setf new-pk-value val)
+                   (update-slot-from-db-value
+                    obj slot
+                    (or new-pk-value
+                        (setf new-pk-value
+                              (database-last-auto-increment-id
+                               database table slot))))))
+             ;; NB: This interacts very strangely with autoincrement keys
+             ;; (see changelog 2014-01-30)
              (chain-primary-keys (in-class)
                "This seems kindof wrong, but this is mostly how it was working, so
                   its here to keep the normalized code path working"
@@ -277,6 +279,7 @@
            (insert-records :into table-sql
                            :av-pairs avps
                            :database database)
+           ;; also handles normalized-class key chaining
            (update-auto-increments-keys view-class obj database)
            ;; we dont set view database here, because there could be
            ;; N of these for each call to update-record-from-* because
@@ -321,12 +324,14 @@
    (specifically clsql-helper:dirty-db-slots-mixin which only updates slots
     that have changed )
   "
-  (declare (ignore to-database-p))
   (setf class (to-class class))
   (let* (rtns)
     (labels ((storable-slots (class)
                (loop for sd in (slots-for-possibly-normalized-class class)
-                     when (key-or-base-slot-p sd)
+                     when (and (key-or-base-slot-p sd)
+                               ;; we dont want to insert/update auto-increments
+                               ;; but we do read them
+                               (not (and to-database-p (auto-increment-column-p sd))))
                      collect sd))
              (get-classes-and-slots (class &aux (normalizedp (normalizedp class)))
                (let ((slots (storable-slots class)))