r9199: fold clsql-base and clsql-base-sys into clsql-base

[clsql.git] / sql / objects.lisp

diff --git a/sql/objects.lisp b/sql/objects.lisp
index 0ea28e93c244ab4054404a392a8ca79bac80c916..ef9c0db369a469c6d2984ed01598761d38098e33 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+)
 
@@ -474,7 +456,7 @@ superclass of the newly-defined View Class."
 
 (defmethod database-get-type-specifier (type args database)
   (declare (ignore type args))
-  (if (clsql-base-sys::in (database-underlying-type database)
+  (if (clsql-base::in (database-underlying-type database)
                          :postgresql :postgresql-socket)
           "VARCHAR"
           "VARCHAR(255)"))
@@ -485,12 +467,16 @@ 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)
   (if args
       (format nil "VARCHAR(~A)" (car args))
-    (if (clsql-base-sys::in (database-underlying-type database) 
+    (if (clsql-base::in (database-underlying-type database) 
                            :postgresql :postgresql-socket)
        "VARCHAR"
       "VARCHAR(255)")))
@@ -499,7 +485,7 @@ superclass of the newly-defined View Class."
                                         database)
   (if args
       (format nil "VARCHAR(~A)" (car args))
-    (if (clsql-base-sys::in (database-underlying-type database) 
+    (if (clsql-base::in (database-underlying-type database) 
                            :postgresql :postgresql-socket)
        "VARCHAR"
       "VARCHAR(255)")))
@@ -507,11 +493,15 @@ superclass of the newly-defined View Class."
 (defmethod database-get-type-specifier ((type (eql 'string)) args database)
   (if args
       (format nil "VARCHAR(~A)" (car args))
-    (if (clsql-base-sys::in (database-underlying-type database) 
+    (if (clsql-base::in (database-underlying-type database) 
                            :postgresql :postgresql-socket)
        "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)
@@ -563,7 +553,7 @@ superclass of the newly-defined View Class."
   (declare (ignore database))
   (progv '(*print-circle* *print-array*) '(t t)
     (let ((escaped (prin1-to-string val)))
-      (clsql-base-sys::substitute-char-string
+      (clsql-base::substitute-char-string
        escaped #\Null " "))))
 
 (defmethod database-output-sql-as-type ((type (eql 'symbol)) val database)
@@ -640,15 +630,24 @@ superclass of the newly-defined View Class."
 (defmethod read-sql-value (val (type (eql 'symbol)) database)
   (declare (ignore database))
   (when (< 0 (length val))
-    (unless (string= val (clsql-base-sys:symbol-name-default-case "NIL"))
-      (intern (clsql-base-sys:symbol-name-default-case val)
+    (unless (string= val (clsql-base:symbol-name-default-case "NIL"))
+      (intern (clsql-base:symbol-name-default-case val)
               (symbol-package *update-context*)))))
 
 (defmethod read-sql-value (val (type (eql 'integer)) database)
   (declare (ignore database))
   (etypecase val
     (string
-     (read-from-string val))
+     (unless (string-equal "NIL" val)
+       (parse-integer val)))
+    (number val)))
+
+(defmethod read-sql-value (val (type (eql 'bigint)) database)
+  (declare (ignore database))
+  (etypecase val
+    (string
+     (unless (string-equal "NIL" val)
+       (parse-integer val)))
     (number val)))
 
 (defmethod read-sql-value (val (type (eql 'float)) database)
@@ -660,6 +659,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-integer val))
+      (number val))))
+
 (defmethod read-sql-value (val (type (eql 'wall-time)) database)
   (declare (ignore database))
   (unless (eq 'NULL val)