+25 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
+ * sql/oodml.lisp: (string n) now produces a CHAR field. Add new VARCHAR
+ type. Added *default-varchar-length* rather than previous hard-coded
+ varchar length. Remove 'simple-string and 'simple-base-string since they
+ are subtypes of 'string.
+ * db-oracle/oracle-sql.lisp: Use *default-varchar-length* rather than
+ local hard-coded value.
+ * sql/metaclasses.lisp: Convert specified type VARCHAR and (VARCHAR n) to Lisp
+ type string. Convert specified-type (CHAR n) to string. Convert specified-type
+ CHAR to lisp type character.
+
25 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
* Version 2.11.1 released: Much simpler Oracle client library loading.
Now uses ORACLE_HOME environmental variable as well as tests default
(in-package #:clsql-oracle)
-(defparameter *oracle-default-varchar2-length* "512")
-
(defmethod database-get-type-specifier (type args database (db-type (eql :oracle)))
(declare (ignore type args database))
- (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")"))
+ (format nil "VARCHAR2(~D)" *default-varchar-length*))
(defmethod database-get-type-specifier ((type (eql 'integer)) args
database (db-type (eql :oracle)))
(or (first args) 38) (or (second args) 0))
"NUMBER(38,0)"))
-(defmethod database-get-type-specifier ((type (eql 'simple-base-string)) args
- database (db-type (eql :oracle)))
- (declare (ignore database))
- (if args
- (format nil "VARCHAR2(~A)" (car args))
- (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
-
-(defmethod database-get-type-specifier ((type (eql 'simple-string)) args
- database (db-type (eql :oracle)))
- (declare (ignore database))
- (if args
- (format nil "VARCHAR2(~A)" (car args))
- (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
-
(defmethod database-get-type-specifier ((type (eql 'string)) args
database (db-type (eql :oracle)))
(declare (ignore database))
(if args
- (format nil "VARCHAR2(~A)" (car args))
- (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
+ (format nil "CHAR(~A)" (car args))
+ (format nil "VARCHAR2(~D)" *default-varchar-length*)))
-(defmethod database-get-type-specifier ((type (eql 'raw-string)) args
+(defmethod database-get-type-specifier ((type (eql 'varchar)) args
database (db-type (eql :oracle)))
(declare (ignore database))
(if args
(format nil "VARCHAR2(~A)" (car args))
- (concatenate 'string "VARCHAR2(" *oracle-default-varchar2-length* ")")))
+ (format nil "VARCHAR2(~D)" *default-varchar-length*)))
(defmethod database-get-type-specifier ((type (eql 'float)) args
database (db-type (eql :oracle)))
(declare (ignore database))
(if args
(format nil "NUMBER(~A,~A)" (or (first args) 38) (or (second args) 38))
- "double precision"))
+ "DOUBLE PRECISION"))
(defmethod database-get-type-specifier ((type (eql 'long-float)) args
database (db-type (eql :oracle)))
(if args
(format nil "NUMBER(~A,~A)"
(or (first args) 38) (or (second args) 38))
- "double precision"))
+ "DOUBLE PRECISION"))
(defmethod database-get-type-specifier ((type (eql 'boolean)) args
database (db-type (eql :oracle)))
((and (symbolp (car specified-type))
(string-equal (symbol-name (car specified-type)) "string"))
'string)
+ ((and (symbolp (car specified-type))
+ (string-equal (symbol-name (car specified-type)) "varchar"))
+ 'string)
+ ((and (symbolp (car specified-type))
+ (string-equal (symbol-name (car specified-type)) "char"))
+ 'string)
(t
specified-type)))
((eq (ensure-keyword specified-type) :bigint)
'integer)
+ ((eq (ensure-keyword specified-type) :char)
+ 'character)
+ ((eq (ensure-keyword specified-type) :varchar)
+ 'string)
((and specified-type
(not (eql :not-null (slot-value slotd 'db-constraints))))
`(or null ,specified-type))
(error "No view-table for class ~A" classname))
(sql-expression :table (view-table class))))
+
+(defparameter *default-varchar-length* 255)
+
(defmethod database-get-type-specifier (type args database db-type)
(declare (ignore type args database db-type))
- "VARCHAR(255)")
+ (format nil "VARCHAR(~D)" *default-varchar-length*))
(defmethod database-get-type-specifier ((type (eql 'integer)) args database db-type)
(declare (ignore database db-type))
(defmethod database-get-type-specifier ((type (eql 'bigint)) args database db-type)
(declare (ignore args database db-type))
"BIGINT")
-
-(defmethod database-get-type-specifier ((type (eql 'simple-base-string)) args
- database db-type)
- (declare (ignore database db-type))
- (if args
- (format nil "VARCHAR(~A)" (car args))
- "VARCHAR(255)"))
-(defmethod database-get-type-specifier ((type (eql 'simple-string)) args
+(deftype varchar ()
+ "A variable length string for the SQL varchar type."
+ '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))
- "VARCHAR(255)"))
+ (format nil "VARCHAR(~D)" *default-varchar-length*)))
(defmethod database-get-type-specifier ((type (eql 'string)) args database db-type)
(declare (ignore database db-type))
(if args
- (format nil "VARCHAR(~A)" (car args))
- "VARCHAR(255)"))
+ (format nil "CHAR(~A)" (car args))
+ (format nil "VARCHAR(~D)" *default-varchar-length*)))
(deftype universal-time ()
"A positive integer as returned by GET-UNIVERSAL-TIME."
(declare (ignore database db-type))
(if args
(format nil "CHAR(~D)" (first args))
- "CHAR"))
+ "CHAR(1)"))
(defmethod database-output-sql-as-type (type val database db-type)
(declare (ignore database db-type))
val)
-(defmethod database-output-sql-as-type ((type (eql 'simple-string))
+(defmethod database-output-sql-as-type ((type (eql 'char))
val database db-type)
(declare (ignore database db-type))
- val)
-
-(defmethod database-output-sql-as-type ((type (eql 'simple-base-string))
- val database db-type)
- (declare (ignore database db-type))
- val)
+ (etypecase val
+ (character (write-to-string val))
+ (string val)))
(defmethod read-sql-value (val type database db-type)
(declare (ignore type database db-type))
(declare (ignore database db-type))
val)
-(defmethod read-sql-value (val (type (eql 'simple-string)) database db-type)
+(defmethod read-sql-value (val (type (eql 'varchar)) database db-type)
(declare (ignore database db-type))
val)
-(defmethod read-sql-value (val (type (eql 'simple-base-string)) database db-type)
+(defmethod read-sql-value (val (type (eql 'char)) database db-type)
(declare (ignore database db-type))
- val)
-
+ (schar val 0))
+
(defmethod read-sql-value (val (type (eql 'keyword)) database db-type)
(declare (ignore database db-type))
(when (< 0 (length val))
;; CLSQL Extensions
#:view-table
#:bigint
+ #:varchar
+ #:*default-varchar-length*
;; OODML (oodml.lisp)
#:instance-refreshed
:initarg :groupid)
(first-name
:accessor first-name
- :type (string 30)
+ :type (varchar 30)
:initarg :first-name)
(last-name
:accessor last-name
- :type (string 30)
+ :type (varchar 30)
:initarg :last-name)
(email
:accessor employee-email
- :type (string 100)
+ :type (varchar 100)
:initarg :email)
(ecompanyid
:type integer
:type integer
:initarg :groupid)
(name
- :type (string 100)
+ :type (varchar 100)
:initarg :name)
(presidentid
:type integer
:type integer
:initarg :street-number)
(street-name
- :type (string 30)
+ :type (varchar 30)
:void-value ""
:initarg :street-name)
(city
:column "city_field"
:void-value "no city"
- :type (string 30)
+ :type (varchar 30)
:initarg :city)
(postal-code
:column zip