(cons (symbol-name-default-case "UNSIGNED") "UNSIGNED")
(cons (symbol-name-default-case "ZEROFILL") "ZEROFILL")
(cons (symbol-name-default-case "AUTO-INCREMENT") "AUTO_INCREMENT")
+ (cons (symbol-name-default-case "DEFAULT") "DEFAULT")
(cons (symbol-name-default-case "UNIQUE") "UNIQUE")))
(defmethod database-constraint-statement (constraint-list database)
:message (format nil "unsupported column constraint '~A'"
constraint))
(setq string (concatenate 'string string (cdr output))))
+ (when (equal (symbol-name (car constraint)) "DEFAULT")
+ (setq constraint (cdr constraint))
+ (setq string (concatenate 'string string " " (car constraint))))
(if (< 1 (length constraint))
(setq string (concatenate 'string string " "))))))))
: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
- (slot-value
- obj (slot-definition-name pk-slot))))))
+ (when (and pk-slot (not pk))
+ (setf pk (if (member :auto-increment (listify (view-class-slot-db-constraints pk-slot)))
+ (setf (slot-value obj (slot-definition-name pk-slot))
+ (database-last-auto-increment-id database
+ table
+ 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)))))))
+ (setf (slot-value obj 'view-database) database))))))
+ ;; handle slots with defaults
+ (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)))
+ (update-slot-from-record obj (slot-definition-name slot))))
+
pk))
(defmethod delete-instance-records ((instance standard-db-object))
((artist_id :accessor artist_id :initarg :id
:type integer :db-kind :key :db-constraints (:not-null :auto-increment)
:autoincrement-sequence 'artist_artist_id_seq)
- (name :accessor name :initarg :name :type (varchar 20))))
+ (name :accessor name :initarg :name :type (varchar 20))
+ (genre :accessor genre :initarg :genre :type (varchar 10) :db-constraints (:default "'Unknown'"))))
(defun initialize-ds-artists ()
; (start-sql-recording :type :both)
(length (clsql:select 'artist :flatp t :caching nil)))
0)
+
+
;; test retrieval is deferred
(deftest :oodm/retrieval/1
(with-dataset *ds-employees*
;; tests update-record-from-slot
(deftest :oodml/update-records/2
(with-dataset *ds-employees*
+ ;(start-sql-recording :type :both)
(values
(employee-email
(car (clsql:select 'employee
:where [= 1 [slot-value 'employee 'emplid]]
:flatp t
:caching nil)))
- (progn
- (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
- (clsql:update-record-from-slot employee1 'email)
+ (progn
+ (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
+ (clsql:update-record-from-slot employee1 'email)
(employee-email
(car (clsql:select 'employee
:where [= 1 [slot-value 'employee 'emplid]]
(list (name artist1) (artist_id artist1)))
("Mogwai" 1))
+(deftest :oodml/update-records/12
+ (with-dataset *ds-artists*
+ (clsql:update-records-from-instance artist1)
+ (list (name artist1) (genre artist1)))
+ ("Mogwai" "Unknown"))
+
;; tests update-instance-from-records
(deftest :oodml/update-instance/1
(with-dataset *ds-employees*