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-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=4a30248613bca9864145306a00bb801cf5348017

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 7389d1c..fd04d42 100644
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -980,6 +980,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)
@@ -999,6 +1000,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 b6f4b41..0ddaaba 100644
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -251,6 +251,12 @@
 			(slot-definition s))
 	     when (sstoredp sd)
 	       collect sd))
+      ;; 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))))
       ;;this may just be a NOP.
       (setf (slot-value obj 'view-database) database)))
 
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 07d9017..8aab537 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*