;; Called by 'get-slot-values-from-view'
;;
-(defvar *update-context* nil)
-
(defmethod update-slot-from-db ((instance standard-db-object) slotdef value)
(declare (optimize (speed 3) #+cmu (extensions:inhibit-warnings 3)))
(let* ((slot-reader (view-class-slot-db-reader slotdef))
(slot-name (slot-definition-name slotdef))
- (slot-type (specified-type slotdef))
- (*update-context* (cons (type-of instance) slot-name)))
+ (slot-type (specified-type slotdef)))
(cond ((and value (null slot-reader))
(setf (slot-value instance slot-name)
(read-sql-value value (delistify slot-type)
(format nil "FLOAT(~A)" (car args))
"FLOAT"))
+(deftype generalized-boolean ()
+ "A type which outputs a SQL boolean value, though any lisp type can be stored in the slot."
+ t)
+
(defmethod database-get-type-specifier ((type (eql 'boolean)) args database db-type)
(declare (ignore args database db-type))
"BOOL")
+(defmethod database-get-type-specifier ((type (eql 'generalized-boolean)) args database db-type)
+ (declare (ignore args database db-type))
+ "BOOL")
+
(defmethod database-get-type-specifier ((type (eql 'number)) args database db-type)
(declare (ignore database db-type))
(cond
(defmethod database-output-sql-as-type ((type (eql 'symbol)) val database db-type)
(declare (ignore database db-type))
- (if (keywordp val)
- (symbol-name val)
- (if val
- (concatenate 'string
- (package-name (symbol-package val))
- "::"
- (symbol-name val))
- "")))
+ (if val
+ (concatenate 'string
+ (package-name (symbol-package val))
+ "::"
+ (symbol-name val))
+ ""))
(defmethod database-output-sql-as-type ((type (eql 'keyword)) val database db-type)
(declare (ignore database db-type))
(declare (ignore database db-type))
(if val "t" "f"))
+(defmethod database-output-sql-as-type ((type (eql 'generalized-boolean)) val database db-type)
+ (declare (ignore database db-type))
+ (if val "t" "f"))
+
(defmethod database-output-sql-as-type ((type (eql 'string)) val database db-type)
(declare (ignore database db-type))
val)
(declare (ignore database db-type))
(when (< 0 (length val))
(unless (string= val (symbol-name-default-case "NIL"))
- (intern (symbol-name-default-case val)
- (symbol-package *update-context*)))))
+ (read-from-string val))))
(defmethod read-sql-value (val (type (eql 'integer)) database db-type)
(declare (ignore database db-type))
(declare (ignore database db-type))
(equal "t" val))
+(defmethod read-sql-value (val (type (eql 'generalized-boolean)) database db-type)
+ (declare (ignore database db-type))
+ (equal "t" val))
+
(defmethod read-sql-value (val (type (eql 'number)) database db-type)
(declare (ignore database db-type))
(etypecase val
(read-from-string val)))
(number val)))
-(defmethod read-sql-value (val (type (eql 'univeral-time)) database db-type)
+(defmethod read-sql-value (val (type (eql 'universal-time)) database db-type)
(declare (ignore database db-type))
(unless (eq 'NULL val)
(etypecase val