Fix behaviour with auto-inc primary keys.

This patch sets the slot value of the field containing the primary key
to the one that the database gave it. Before, it wasn't saved so then
changes to other slots didn't update the database (since the query
ended up looking something like "UPDATE blah WHEN id = 'NULL' ...",
which obviously doesn't work).

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 710e5e8e090c45548e4a41d6948ccd35c7c7536c..7bf7d5bf77db5adcb9bed1ca976ca7082a2afebb 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -265,6 +265,7 @@
                                          (ordered-class-direct-slots view-class)
                                          (ordered-class-slots view-class))))
                (record-values (mapcar #'slot-value-list slots)))
+
           (cond ((and (not (normalizedp view-class))
                       (not record-values))
                  (error "No settable slots."))
@@ -285,16 +286,22 @@
                  (insert-records :into (sql-expression :table view-class-table)
                                  :av-pairs record-values
                                  :database database)
+
                  (when pk-slot
                    (if (or (and (listp (view-class-slot-db-constraints pk-slot))
                                 (member :auto-increment (view-class-slot-db-constraints pk-slot)))
                            (eql (view-class-slot-db-constraints pk-slot) :auto-increment))
+                       (unless pk
+                         (let ((db-pk (car (query "SELECT LAST_INSERT_ID();"
+                                                  :flatp t :field-names nil
+                                                  :database database))))
+                           (setf pk db-pk
+                                 (slot-value
+                                  obj (slot-definition-name pk-slot)) db-pk)))
+
                        (setf pk (or pk
-                                    (car (query "SELECT LAST_INSERT_ID();"
-                                                :flatp t :field-names nil
-                                                :database database))))
-                       (setf pk (or pk
-                                    (slot-value obj (slot-definition-name pk-slot))))))
+                                    (slot-value
+                                     obj (slot-definition-name pk-slot))))))
                  (when (eql this-class nil)
                    (setf (slot-value obj 'view-database) database)))))))
     pk))