r9197: add universal-time and bigint types

[clsql.git] / sql / objects.lisp

diff --git a/sql/objects.lisp b/sql/objects.lisp
index 0ea28e93c244ab4054404a392a8ca79bac80c916..4535978c9ae254bc827bb0d01382766dc847018e 100644 (file)
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -425,30 +425,12 @@ superclass of the newly-defined View Class."
       (get-slot-values-from-view instance (list slot-def) (car res)))))
 
 
-(defmethod database-null-value ((type t))
-  (cond
-    ((subtypep type 'string) nil)
-    ((subtypep type 'integer) nil)
-    ((subtypep type 'list) nil)
-    ((subtypep type 'boolean) nil)
-    ((eql type t) nil)
-    ((subtypep type 'symbol) nil)
-    ((subtypep type 'keyword) nil)
-    ((subtypep type 'wall-time) nil)
-    ((subtypep type 'duration) nil)
-    ((subtypep type 'money) nil)
-    (t
-     (error "Unable to handle null for type ~A" type))))
-
 (defmethod update-slot-with-null ((object standard-db-object)
                                  slotname
                                  slotdef)
   (let ((st (slot-type slotdef))
-        (allowed (slot-value slotdef 'nulls-ok)))
-    (if allowed
-        (setf (slot-value object slotname) nil)
-        (setf (slot-value object slotname)
-              (database-null-value st)))))
+        (void-value (slot-value slotdef 'void-value)))
+    (setf (slot-value object slotname) void-value)))
 
 (defvar +no-slot-value+ '+no-slot-value+)
 
@@ -485,6 +467,10 @@ superclass of the newly-defined View Class."
   (if args
       (format nil "INT(~A)" (car args))
       "INT"))
+
+(defmethod database-get-type-specifier ((type (eql 'bigint)) args database)
+  (declare (ignore args database))
+  "BIGINT")
               
 (defmethod database-get-type-specifier ((type (eql 'simple-base-string)) args
                                         database)
@@ -512,6 +498,10 @@ superclass of the newly-defined View Class."
        "VARCHAR"
       "VARCHAR(255)")))
 
+(defmethod database-get-type-specifier ((type (eql 'universal-time)) args database)
+  (declare (ignore args database))
+  "BIGINT")
+
 (defmethod database-get-type-specifier ((type (eql 'wall-time)) args database)
   (declare (ignore args))
   (case (database-underlying-type database)
@@ -648,7 +638,14 @@ superclass of the newly-defined View Class."
   (declare (ignore database))
   (etypecase val
     (string
-     (read-from-string val))
+     (parse-integer val))
+    (number val)))
+
+(defmethod read-sql-value (val (type (eql 'bigint)) database)
+  (declare (ignore database))
+  (etypecase val
+    (string
+     (parse-integer val))
     (number val)))
 
 (defmethod read-sql-value (val (type (eql 'float)) database)
@@ -660,6 +657,14 @@ superclass of the newly-defined View Class."
   (declare (ignore database))
   (equal "t" val))
 
+(defmethod read-sql-value (val (type (eql 'univeral-time)) database)
+  (declare (ignore database))
+  (unless (eq 'NULL val)
+  (etypecase val
+    (string
+     (parse-intger val))
+    (number val)))
+
 (defmethod read-sql-value (val (type (eql 'wall-time)) database)
   (declare (ignore database))
   (unless (eq 'NULL val)