From: Holger Schauer <Holger.Schauer@gmx.de>
Date: Thu, 3 Mar 2011 14:37:31 +0000 (+0100)
Subject: Add support for :default in db constraints. make-constraint-description: use next... 
X-Git-Tag: v5.3.0~7
X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=818295fa37036acb348ff24ea926b9d7c9f33cba

Add support for :default in db constraints. make-constraint-description: use next element as default value for default constraint. update-record-from-slots: fetch value for slots with defaults. ds-artists: add genre slot with default constraint. test-oodml: new test update-records/12 checks working default constraint.
---

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index 5e75b01..45d4631 100644
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -990,6 +990,7 @@ uninclusive, and the args from that keyword to the end."
    (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)
@@ -1009,6 +1010,9 @@ uninclusive, and the args from that keyword to the end."
                        :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 " "))))))))
 
diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 7bf7d5b..dc010fb 100644
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -287,23 +287,24 @@
                                  :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))
diff --git a/tests/ds-artists.lisp b/tests/ds-artists.lisp
index 8fe86d2..4637fde 100644
--- a/tests/ds-artists.lisp
+++ b/tests/ds-artists.lisp
@@ -8,7 +8,8 @@
   ((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)
diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp
index d1c933a..29b8059 100644
--- a/tests/test-oodml.lisp
+++ b/tests/test-oodml.lisp
@@ -216,6 +216,8 @@
       (length (clsql:select 'artist :flatp t :caching nil)))
   0)
 
+
+
 ;; test retrieval is deferred
 (deftest :oodm/retrieval/1
     (with-dataset *ds-employees*
@@ -304,15 +306,16 @@
 ;; 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]]
@@ -625,6 +628,12 @@
       (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*