diff --git a/src/package.lisp b/src/package.lisp index d5bcaae..782fd0b 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -92,6 +92,7 @@ #:table-trigger-list #:sqltype-name + #:sqltype-schema #:sqltype-type #:sqltype-source-def #:sqltype-extra diff --git a/src/pgsql/pgsql-ddl.lisp b/src/pgsql/pgsql-ddl.lisp index 81323f1..0182bd3 100644 --- a/src/pgsql/pgsql-ddl.lisp +++ b/src/pgsql/pgsql-ddl.lisp @@ -24,7 +24,8 @@ (declare (ignore if-not-exists)) (ecase (sqltype-type sqltype) ((:enum :set) - (format stream "CREATE TYPE ~a AS ENUM (~{'~a'~^, ~});" + (format stream "CREATE TYPE ~@[~a.~]~a AS ENUM (~{'~a'~^, ~});" + (schema-name (sqltype-schema sqltype)) (sqltype-name sqltype) (mapcar (lambda (value) (cl-ppcre:regex-replace-all "'" value "''")) @@ -88,8 +89,12 @@ (let ((type-name (column-type-name column))) (typecase type-name (sqltype (ecase (sqltype-type type-name) - (:enum (sqltype-name type-name)) - (:set (format nil "~a[]" (sqltype-name type-name))))) + (:enum (format nil "~@[~a~].~a" + (schema-name (sqltype-schema type-name)) + (sqltype-name type-name))) + (:set (format nil "~@[~a~].~a[]" + (schema-name (sqltype-schema type-name)) + (sqltype-name type-name))))) (string type-name)))) (defmethod format-create-sql ((column column) diff --git a/src/sources/db3/db3-schema.lisp b/src/sources/db3/db3-schema.lisp index 53e5b41..06cbbc9 100644 --- a/src/sources/db3/db3-schema.lisp +++ b/src/sources/db3/db3-schema.lisp @@ -52,7 +52,7 @@ (db3::field-type field) (db3::field-length field))))) -(defmethod cast ((field db3-field)) +(defmethod cast ((field db3-field) &key &allow-other-keys) "Return the PostgreSQL type definition given the DB3 one." (let* ((type (db3-field-type field)) (transform diff --git a/src/sources/ixf/ixf-schema.lisp b/src/sources/ixf/ixf-schema.lisp index 3162901..9c537a6 100644 --- a/src/sources/ixf/ixf-schema.lisp +++ b/src/sources/ixf/ixf-schema.lisp @@ -80,7 +80,7 @@ (when c (princ-to-string c))))))) -(defmethod cast ((col ixf:ixf-column)) +(defmethod cast ((col ixf:ixf-column) &key &allow-other-keys) "Return the PostgreSQL type definition from given IXF column definition." (make-column :name (apply-identifier-case (ixf:ixf-column-name col)) :type-name (cast-ixf-type (ixf:ixf-column-type col)) diff --git a/src/sources/mssql/mssql-cast-rules.lisp b/src/sources/mssql/mssql-cast-rules.lisp index 2cf0089..1bb6732 100644 --- a/src/sources/mssql/mssql-cast-rules.lisp +++ b/src/sources/mssql/mssql-cast-rules.lisp @@ -119,7 +119,7 @@ (t type)))) -(defmethod cast ((field mssql-column)) +(defmethod cast ((field mssql-column) &key &allow-other-keys) "Return the PostgreSQL type definition from given MS SQL column definition." (with-slots (schema table-name name type default nullable) field diff --git a/src/sources/mysql/mysql-cast-rules.lisp b/src/sources/mysql/mysql-cast-rules.lisp index beb017e..1dea915 100644 --- a/src/sources/mysql/mysql-cast-rules.lisp +++ b/src/sources/mysql/mysql-cast-rules.lisp @@ -159,7 +159,7 @@ ("(?i)(?:ENUM|SET)\\s*\\((.*)\\)" ctype) (first (cl-csv:read-csv list :separator #\, :quote #\' :escape "''")))) -(defmethod cast ((col mysql-column)) +(defmethod cast ((col mysql-column) &key table) "Return the PostgreSQL type definition from given MySQL column definition." (with-slots (table-name name dtype ctype default nullable extra comment) col @@ -202,6 +202,7 @@ (when (string= sqltype-name (column-type-name pgcol)) (setf (column-type-name pgcol) (make-sqltype :name sqltype-name + :schema (table-schema table) :type (intern (string-upcase dtype) (find-package "KEYWORD")) :source-def ctype diff --git a/src/sources/sqlite/sqlite-cast-rules.lisp b/src/sources/sqlite/sqlite-cast-rules.lisp index 2160c66..3f641b0 100644 --- a/src/sources/sqlite/sqlite-cast-rules.lisp +++ b/src/sources/sqlite/sqlite-cast-rules.lisp @@ -80,7 +80,7 @@ (paren-pos (position #\( ctype))) (if paren-pos (subseq ctype 0 paren-pos) ctype))) -(defmethod cast ((col coldef)) +(defmethod cast ((col coldef) &key &allow-other-keys) "Return the PostgreSQL type definition from given SQLite column definition." (with-slots (table-name name dtype ctype default nullable extra) col diff --git a/src/utils/catalog.lisp b/src/utils/catalog.lisp index 1855740..4a94bf9 100644 --- a/src/utils/catalog.lisp +++ b/src/utils/catalog.lisp @@ -54,7 +54,7 @@ ;;; need to be tranformed dynamically into User Defined Types: ENUMs, SET, ;;; etc. ;;; -(defstruct sqltype name type source-def extra) +(defstruct sqltype name schema type source-def extra) ;;; ;;; The generic PostgreSQL column that the CAST generic function is asked to @@ -157,7 +157,7 @@ (defgeneric max-indexes-per-table (schema &key) (:documentation "Count how many indexes we have maximum per table in SCHEMA.")) -(defgeneric cast (object) +(defgeneric cast (object &key) (:documentation "Cast a FIELD definition from a source database into a PostgreSQL COLUMN definition.")) @@ -272,11 +272,13 @@ "Add COLUMN name to INDEX and return the INDEX." (push-to-end (apply-identifier-case column) (index-columns index))) -(defmethod cast ((table table)) +(defmethod cast ((table table) &key) "Cast all fields in table into columns." - (setf (table-column-list table) (mapcar #'cast (table-field-list table)))) + (setf (table-column-list table) + (loop :for field :in (table-field-list table) + :collect (cast field :table table)))) -(defmethod cast ((schema schema)) +(defmethod cast ((schema schema) &key) "Cast all fields of all tables in SCHEMA into columns." (loop :for table :in (schema-table-list schema) :do (cast table)) @@ -284,7 +286,7 @@ (loop :for view :in (schema-view-list schema) :do (cast view))) -(defmethod cast ((catalog catalog)) +(defmethod cast ((catalog catalog) &key) "Cast all fields of all tables in all schemas in CATALOG into columns." (loop :for schema :in (catalog-schema-list catalog) :do (cast schema)))