X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Foodml.lisp;fp=sql%2Foodml.lisp;h=1599f17e6fcf00b38cf15089811d23410e9c8fc9;hp=4197ea23b7efaa70cafbc9317a9c302b41c3d715;hb=4f756ab532ff033a34597a1c8030379e252952ca;hpb=29e203446b2275fd2353642510cd4b2903d07d1c diff --git a/sql/oodml.lisp b/sql/oodml.lisp index 4197ea2..1599f17 100644 --- a/sql/oodml.lisp +++ b/sql/oodml.lisp @@ -576,119 +576,70 @@ value)) (otherwise (call-next-method))))))) -(defmethod read-sql-value (val type database db-type) +(defmethod read-sql-value (val type database db-type + &aux *read-eval*) (declare (ignore database db-type)) + ;; TODO: All the read-from-strings in here do not check that + ;; what we read was of the correct type, should this change? + + ;; TODO: Should this case `(typep val type)=>t` be an around + ;; method that short ciruits? (cond ((null type) val) ;;we have no desired type, just give the value ((typep val type) val) ;;check that it hasn't already been converted. ((typep val 'string) (read-from-string val)) ;;maybe read will just take care of it? (T (error "Unable to read-sql-value ~a as type ~a" val type)))) -(defmethod read-sql-value (val (type (eql 'string)) database db-type) - (declare (ignore database db-type)) - val) - -(defmethod read-sql-value (val (type (eql 'varchar)) database db-type) - (declare (ignore database db-type)) - val) - -(defmethod read-sql-value (val (type (eql 'char)) database db-type) - (declare (ignore database db-type)) - (schar val 0)) - -(defmethod read-sql-value (val (type (eql 'keyword)) database db-type) - (declare (ignore database db-type)) - (when (< 0 (length val)) - (intern (symbol-name-default-case val) - (find-package '#:keyword)))) - -(defmethod read-sql-value (val (type (eql 'symbol)) database db-type) - (declare (ignore database db-type)) - (when (< 0 (length val)) - (unless (string= val (symbol-name-default-case "NIL")) - (read-from-string val)))) - -(defmethod read-sql-value (val (type (eql 'integer)) database db-type) - (declare (ignore database db-type)) - (etypecase val - (string - (unless (string-equal "NIL" val) - (parse-integer val))) - (number val))) - -(defmethod read-sql-value (val (type (eql 'smallint)) database db-type) - (declare (ignore database db-type)) - (etypecase val - (string - (unless (string-equal "NIL" val) - (parse-integer val))) - (number val))) - -(defmethod read-sql-value (val (type (eql 'bigint)) database db-type) - (declare (ignore database db-type)) - (etypecase val - (string - (unless (string-equal "NIL" val) - (parse-integer val))) - (number val))) - -(defmethod read-sql-value (val (type (eql 'float)) database db-type) - (declare (ignore database db-type)) - ;; writing 1.0 writes 1, so we we *really* want a float, must do (float ...) - (etypecase val - (string (float (read-from-string val))) - (float val))) - -(defmethod read-sql-value (val (type (eql 'double-float)) database db-type) - (declare (ignore database db-type)) - ;; writing 1.0 writes 1, so if we *really* want a float, must do (float ...) - (etypecase val - (string (float - (let ((*read-default-float-format* 'double-float)) - (read-from-string val)) - 1.0d0)) - (double-float val) - (float (coerce val 'double-float)))) - -(defmethod read-sql-value (val (type (eql 'boolean)) 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 - (string - (unless (string-equal "NIL" val) - (read-from-string val))) - (number val))) - -(defmethod read-sql-value (val (type (eql 'universal-time)) database db-type) - (declare (ignore database db-type)) - (unless (eq 'NULL val) - (etypecase val - (string - (parse-integer val)) - (number val)))) - -(defmethod read-sql-value (val (type (eql 'wall-time)) database db-type) - (declare (ignore database db-type)) - (unless (eq 'NULL val) - (parse-timestring val))) - -(defmethod read-sql-value (val (type (eql 'date)) database db-type) - (declare (ignore database db-type)) - (unless (eq 'NULL val) - (parse-datestring val))) - -(defmethod read-sql-value (val (type (eql 'duration)) database db-type) - (declare (ignore database db-type)) - (unless (or (eq 'NULL val) - (equal "NIL" val)) - (parse-timestring val))) +(defmethod read-sql-value (val (type symbol) database db-type + ;; never eval while reading values + &aux *read-eval*) + ;; TODO: All the read-from-strings in here do not check that + ;; what we read was of the correct type, should this change? + (unless (or (equalp "nil" val) (eql 'null val)) + (case type + ((string varchar) val) + (char (etypecase val + (string (schar val 0)) + (character val))) + (keyword + (when (< 0 (length val)) + (intern (symbol-name-default-case val) :keyword))) + (symbol + (when (< 0 (length val)) + (intern (symbol-name-default-case val)))) + ((smallint mediumint bigint integer universal-time) + (etypecase val + (string (parse-integer val)) + (number val))) + ((double-float float) + ;; ensure that whatever we got is coerced to a float of the correct + ;; type (eg: 1=>1.0d0) + (float + (etypecase val + (string (let ((*read-default-float-format* + (ecase type + (float 'single-float) + (double-float 'double-float)))) + (read-from-string val))) + (float val)) + (if (eql type 'double-float) 1.0d0 1.0s0))) + (number + (etypecase val + (string (read-from-string val)) + (number val))) + ((boolean generalized-boolean) + (if (member val '(nil t)) + val + (etypecase val + (string + (when (member val '("1" "t" "true" "y") :test #'string-equal) + t)) + (number (not (zerop val)))))) + ((wall-time duration) + (parse-timestring val)) + (date + (parse-datestring val)) + (t (call-next-method))))) ;; ------------------------------------------------------------ ;; Logic for 'faulting in' :join slots