the public api"
(update-record-from-slots obj slot :database database))
-(defun view-classes-and-storable-slots (class)
+(defmethod view-classes-and-storable-slots (class)
"Get a list of all the tables we need to update and the slots on them
for non normalized classes we return the class and all its storable slots
(error "No view-table for class ~A" classname))
(sql-expression :table (view-table class))))
-
-(defmethod database-get-type-specifier (type args database db-type)
- (declare (ignore type args database db-type))
- (format nil "VARCHAR(~D)" *default-string-length*))
-
-(defmethod database-get-type-specifier ((type (eql 'integer)) args database db-type)
- (declare (ignore database db-type))
- (if args
- (format nil "INT(~A)" (car args))
- "INT"))
-
(deftype tinyint ()
"An 8-bit integer, this width may vary by SQL implementation."
'integer)
-(defmethod database-get-type-specifier ((type (eql 'tinyint)) args database db-type)
- (declare (ignore args database db-type))
- "INT")
-
(deftype smallint ()
"An integer smaller than a 32-bit integer. this width may vary by SQL implementation."
'integer)
-(defmethod database-get-type-specifier ((type (eql 'smallint)) args database db-type)
- (declare (ignore args database db-type))
- "INT")
-
(deftype mediumint ()
"An integer smaller than a 32-bit integer, but may be larger than a smallint. This width may vary by SQL implementation."
'integer)
-(defmethod database-get-type-specifier ((type (eql 'mediumint)) args database db-type)
- (declare (ignore args database db-type))
- "INT")
-
(deftype bigint ()
"An integer larger than a 32-bit integer, this width may vary by SQL implementation."
'integer)
-(defmethod database-get-type-specifier ((type (eql 'bigint)) args database db-type)
- (declare (ignore args database db-type))
- "BIGINT")
-
(deftype varchar (&optional size)
"A variable length string for the SQL varchar type."
(declare (ignore size))
'string)
-(defmethod database-get-type-specifier ((type (eql 'varchar)) args
- database db-type)
- (declare (ignore database db-type))
- (if args
- (format nil "VARCHAR(~A)" (car args))
- (format nil "VARCHAR(~D)" *default-string-length*)))
-
-(defmethod database-get-type-specifier ((type (eql 'string)) args database db-type)
- (declare (ignore database db-type))
- (if args
- (format nil "CHAR(~A)" (car args))
- (format nil "VARCHAR(~D)" *default-string-length*)))
-
(deftype universal-time ()
"A positive integer as returned by GET-UNIVERSAL-TIME."
'(integer 1 *))
-(defmethod database-get-type-specifier ((type (eql 'universal-time)) args database db-type)
- (declare (ignore args database db-type))
- "BIGINT")
-
-(defmethod database-get-type-specifier ((type (eql 'wall-time)) args database db-type)
- (declare (ignore args database db-type))
- "TIMESTAMP")
-
-(defmethod database-get-type-specifier ((type (eql 'date)) args database db-type)
- (declare (ignore args database db-type))
- "DATE")
-
-(defmethod database-get-type-specifier ((type (eql 'duration)) args database db-type)
- (declare (ignore database args db-type))
- "VARCHAR")
-
-(defmethod database-get-type-specifier ((type (eql 'money)) args database db-type)
- (declare (ignore database args db-type))
- "INT8")
+(deftype generalized-boolean ()
+ "A type which outputs a SQL boolean value, though any lisp type can be stored in the slot."
+ t)
#+ignore
(deftype char (&optional len)
"A lisp type for the SQL CHAR type."
`(string ,len))
-(defmethod database-get-type-specifier ((type (eql 'float)) args database db-type)
- (declare (ignore database db-type))
- (if args
- (format nil "FLOAT(~A)" (car args))
- "FLOAT"))
-
-(defmethod database-get-type-specifier ((type (eql 'long-float)) args database db-type)
- (declare (ignore database db-type))
- (if args
- (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)
+(defmethod database-get-type-specifier ((type string) args database (db-type t))
+ "Pass through the literal type as defined in the type string"
(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
- ((and (consp args) (= (length args) 2))
- (format nil "NUMBER(~D,~D)" (first args) (second args)))
- ((and (consp args) (= (length args) 1))
- (format nil "NUMBER(~D)" (first args)))
- (t
- "NUMBER")))
-
-(defmethod database-get-type-specifier ((type (eql 'char)) args database db-type)
- (declare (ignore database db-type))
- (if args
- (format nil "CHAR(~D)" (first args))
- "CHAR(1)"))
-
+ type)
+
+
+(defmethod database-get-type-specifier ((type symbol) args database db-type)
+ (case type
+ (char (if args
+ (format nil "CHAR(~D)" (first args))
+ "CHAR(1)"))
+ ((varchar string)
+ (if args
+ (format nil "VARCHAR(~A)" (car args))
+ (format nil "VARCHAR(~D)" *default-string-length*)))
+ ((longchar text) "text")
+ (integer (if args
+ (format nil "INT(~A)" (car args))
+ "INT"))
+ ((tinyint smallint mediumint) "INT")
+ ((long-float float)
+ (if args
+ (format nil "FLOAT(~A)" (car args))
+ "FLOAT"))
+ ((bigint universal-time) "BIGINT")
+ (number
+ (cond
+ ((and (consp args) (= (length args) 2))
+ (format nil "NUMBER(~D,~D)" (first args) (second args)))
+ ((and (consp args) (= (length args) 1))
+ (format nil "NUMBER(~D)" (first args)))
+ (t
+ "NUMBER")))
+ (wall-time "TIMESTAMP")
+ (date "DATE")
+ (duration "VARCHAR")
+ (money "INT8")
+ ((boolean generalized-boolean) "BOOL")
+ (t (warn "Could not determine a valid ~A type specifier for ~A ~A ~A, defaulting to VARCHAR "
+ db-type type args database)
+ (format nil "VARCHAR(~D)" *default-string-length*))))
(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 (eql 'list)) val database db-type)
- (declare (ignore database db-type))
- (progv '(*print-circle* *print-array*) '(t t)
- (let ((escaped (prin1-to-string val)))
- (substitute-char-string
- escaped #\Null " "))))
-
-(defmethod database-output-sql-as-type ((type (eql 'symbol)) val database db-type)
- (declare (ignore database db-type))
- (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))
- (if val
- (symbol-name val)
- ""))
-
-(defmethod database-output-sql-as-type ((type (eql 'vector)) val database db-type)
- (declare (ignore database db-type))
- (progv '(*print-circle* *print-array*) '(t t)
- (prin1-to-string val)))
-
-(defmethod database-output-sql-as-type ((type (eql 'array)) val database db-type)
- (declare (ignore database db-type))
- (progv '(*print-circle* *print-array*) '(t t)
- (prin1-to-string val)))
-
-(defmethod database-output-sql-as-type ((type (eql 'boolean)) val 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)
-
-(defmethod database-output-sql-as-type ((type (eql 'char)) val database db-type)
- (declare (ignore database db-type))
- (etypecase val
- (character (write-to-string val))
- (string val)))
-
-(defmethod database-output-sql-as-type ((type (eql 'float)) val database db-type)
- (declare (ignore database db-type))
- (if (eq (type-of val) 'null)
- nil
- (let ((*read-default-float-format* (type-of val)))
- (format nil "~F" val))))
+(defmethod database-output-sql-as-type ((type symbol) val database db-type)
+ (declare (ignore database))
+ (case type ;; booleans handle null differently
+ ((boolean generalized-boolean)
+ (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
+ (symbol
+ (format nil "~A::~A"
+ (package-name (symbol-package val))
+ (symbol-name val)))
+ (keyword (symbol-name 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)
+ (value (prin1-to-string val)))
+ value))
+ (otherwise (call-next-method)))))))
(defmethod read-sql-value (val type database db-type)
(declare (ignore database db-type))
projects / clsql.git / blobdiff