From e7a214b2445830219022acb5911a3f9303d938bd Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 25 May 2004 10:55:10 +0000 Subject: [PATCH] r9478: 25 May 2004 Kevin Rosenberg * 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. --- ChangeLog | 11 +++++++++ db-oracle/oracle-objects.lisp | 30 ++++++----------------- sql/metaclasses.lisp | 10 ++++++++ sql/oodml.lisp | 45 ++++++++++++++++------------------- sql/package.lisp | 2 ++ tests/test-init.lisp | 12 +++++----- 6 files changed, 57 insertions(+), 53 deletions(-) diff --git a/ChangeLog b/ChangeLog index 85e89e2..782203e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +25 May 2004 Kevin Rosenberg + * 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 * Version 2.11.1 released: Much simpler Oracle client library loading. Now uses ORACLE_HOME environmental variable as well as tests default diff --git a/db-oracle/oracle-objects.lisp b/db-oracle/oracle-objects.lisp index 5f26515..9cebea1 100644 --- a/db-oracle/oracle-objects.lisp +++ b/db-oracle/oracle-objects.lisp @@ -15,11 +15,9 @@ (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))) @@ -37,40 +35,26 @@ (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))) @@ -78,7 +62,7 @@ (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))) diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp index f4c87e0..a43c4ac 100644 --- a/sql/metaclasses.lisp +++ b/sql/metaclasses.lisp @@ -392,10 +392,20 @@ which does type checking before storing a value in a slot." ((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)) diff --git a/sql/oodml.lisp b/sql/oodml.lisp index e2f6b48..ab53377 100644 --- a/sql/oodml.lisp +++ b/sql/oodml.lisp @@ -309,9 +309,12 @@ (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)) @@ -326,26 +329,23 @@ (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." @@ -402,7 +402,7 @@ (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) @@ -451,15 +451,12 @@ (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)) @@ -469,14 +466,14 @@ (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)) diff --git a/sql/package.lisp b/sql/package.lisp index c180f46..e757277 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -330,6 +330,8 @@ ;; CLSQL Extensions #:view-table #:bigint + #:varchar + #:*default-varchar-length* ;; OODML (oodml.lisp) #:instance-refreshed diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 65930c2..6f15d41 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -55,15 +55,15 @@ :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 @@ -107,7 +107,7 @@ :type integer :initarg :groupid) (name - :type (string 100) + :type (varchar 100) :initarg :name) (presidentid :type integer @@ -137,13 +137,13 @@ :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 -- 2.34.1