(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."))
(setf pk (or pk
(slot-value obj (slot-definition-name pk-slot))))))
(t
- (insert-records :into (sql-expression :table view-class-table)
+ (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))
- (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))))))
- (when (eql this-class nil)
- (setf (slot-value obj 'view-database) database)))))))
+
+ (when (and pk-slot (not pk))
+ (setf pk (if (or (member :auto-increment (listify (view-class-slot-db-constraints pk-slot)))
+ (not (null (view-class-slot-autoincrement-sequence pk-slot))))
+ (setf (slot-value obj (slot-definition-name pk-slot))
+ (database-last-auto-increment-id database
+ view-class-table
+ pk-slot)))))
+ (when pk-slot
+ (setf pk (or pk
+ (slot-value
+ obj (slot-definition-name pk-slot)))))
+ (when (eql this-class nil)
+ (setf (slot-value obj 'view-database) database)))))))
+ ;; handle slots with defaults
+ (let* ((view-class (or this-class (class-of obj)))
+ (slots (if (normalizedp view-class)
+ (ordered-class-direct-slots view-class)
+ (ordered-class-slots view-class))))
+ (dolist (slot slots)
+ (when (and (slot-exists-p slot 'db-constraints)
+ (listp (view-class-slot-db-constraints slot))
+ (member :default (view-class-slot-db-constraints slot)))
+ (unless (and (slot-boundp obj (slot-definition-name slot))
+ (slot-value obj (slot-definition-name slot)))
+ (update-slot-from-record obj (slot-definition-name slot))))))
+
pk))
(defmethod delete-instance-records ((instance standard-db-object))