(char (if args
(format nil "CHAR(~D)" (first args))
"CHAR(1)"))
- ((varchar string)
+ ((varchar string symbol keyword)
(if args
(format nil "VARCHAR(~A)" (car args))
(format nil "VARCHAR(~D)" *default-string-length*)))
(*print-readably* t))
(prin1-to-string in))
-(defmethod database-output-sql-as-type (type val database db-type)
- (declare (ignore type database db-type))
- val)
-
-(defmethod database-output-sql-as-type ((type symbol) val database db-type)
+(defmethod database-output-sql-as-type
+ (type val database db-type
+ &aux
+ (*print-circle* t) (*print-array* t)
+ (*print-length* nil) (*print-base* #10r10))
(declare (ignore database))
- (case type ;; booleans handle null differently
- ((boolean generalized-boolean)
+ (cond
+ ((null type) val)
+ ((member type '(boolean generalized-boolean))
+ ;; booleans handle null differently
(case db-type
;; done here so it can be done once
((:mssql :mysql) (if val 1 0))
(otherwise (if val "t" "f"))))
- (otherwise
- ;; in all other cases if we have nil give everyone else a shot at it,
- ;; which by default returns nil
- (if (null val)
- (call-next-method)
- (case type
- ((or symbol keyword)
- (print-readable-symbol val))
- (string val)
- (char (etypecase val
- (character (write-to-string val))
- (string val)))
- (float (format nil "~F" val))
- ((list vector array)
- (let* ((*print-circle* t)
- (*print-array* t)
- (*print-length* nil)
- (value (prin1-to-string val)))
- value))
- (otherwise (call-next-method)))))))
+ ((null val)
+ (when (next-method-p)
+ (call-next-method)))
+ (t
+ (case type
+ ((or symbol keyword)
+ (print-readable-symbol val))
+ (string val)
+ (char (etypecase val
+ (character (write-to-string val))
+ (string val)))
+ (float (format nil "~F" val))
+ ((list vector array)
+ (prin1-to-string val))
+ (otherwise
+ (if (next-method-p)
+ (call-next-method)
+ val))))))
(defmethod read-sql-value :around
(val type database db-type
- &aux *read-eval*)
+ ;; never eval while reading values, always read base 10
+ &aux *read-eval* (*read-base* #10r10))
(declare (ignore db-type))
(cond
;; null value or type
- ((or (equalp "nil" val) (eql 'null val)) nil)
-
+ ((or (null val)
+ (equalp "nil" val)
+ (eql 'null val)
+ (eql 'null type))
+ nil)
+
;; no specified type or already the right type
((or (null type)
(ignore-errors (typep val type)))
val)
;; actually convert
- (t
+ (t
(let ((res (handler-bind
;; all errors should be converted to sql-value-conversion-error
((error (lambda (c)
- (when *debugger-hook*
- (invoke-debugger c))
(unless (typep c 'sql-value-conversion-error)
+ ;; this was blowing up the tests till I
+ ;; unbound *debugger-hook* not sure the answer,
+ ;; as this is also imensely useful in actually
+ ;; finding bugs below this point
+ (when *debugger-hook* (invoke-debugger c))
(error-converting-value val type database)))))
(call-next-method))))
;; if we didnt get the right type after converting, we should probably
;; error right away
- (maybe-error-converting-value
- res val type database)))))
+ (maybe-error-converting-value res val type database)))))
-(defmethod read-sql-value (val type database db-type
- ;; never eval while reading values
- &aux *read-eval*)
+(defmethod read-sql-value (val type database db-type)
+ "read a sql value, from :around read-eval is disabled read numbers in base 10"
;; errors, nulls and preconverted types are already handled in around
(typecase type
(symbol
(double-float 'double-float))))
(read-from-string val)))
;; maybe wrong type of float
- (float val))
+ (float val))
(if (eql type 'double-float) 1.0d0 1.0s0)))
- (number (read-from-string val))
+ (number (read-decimal-value val))
((boolean generalized-boolean)
(if (member val '(nil t))
val
(number (not (zerop val))))))
((wall-time duration) (parse-timestring val))
(date (parse-datestring val))
- (t (call-next-method))))
+ (list (read-from-string val))
+ (t (error-converting-value val type database))))
(t (typecase val
(string (read-from-string val))
(t (error-converting-value val type database))))))