From 5b87b1a85e5d49cd6c05cc657606056dcb517d92 Mon Sep 17 00:00:00 2001 From: Dimitri Fontaine Date: Fri, 21 Nov 2014 23:32:02 +0100 Subject: [PATCH] Refactor *identifier-case* option into a dynamic binding. That makes it much easier to use from about anywhere in the code, which is what is needed. In passing, fix #129. --- src/params.lisp | 7 ++ src/parsers/command-dbf.lisp | 1 + src/parsers/command-ixf.lisp | 1 + src/parsers/command-mssql.lisp | 1 + src/parsers/command-mysql.lisp | 1 + src/parsers/command-options.lisp | 7 +- src/pgsql/schema.lisp | 101 +++++++++------------- src/sources/db3.lisp | 4 +- src/sources/ixf.lisp | 5 +- src/sources/mssql.lisp | 18 ++-- src/sources/mssql/mssql-cast-rules.lisp | 5 +- src/sources/mssql/mssql-schema.lisp | 59 +++++++------ src/sources/mysql.lisp | 37 +++----- src/sources/mysql/mysql-cast-rules.lisp | 12 ++- src/sources/mysql/mysql-schema.lisp | 34 +++----- src/sources/sqlite.lisp | 8 +- src/sources/sqlite/sqlite-cast-rules.lisp | 5 +- src/sources/sqlite/sqlite-schema.lisp | 3 +- 18 files changed, 133 insertions(+), 176 deletions(-) diff --git a/src/params.lisp b/src/params.lisp index 8454f78..a6e8fea 100644 --- a/src/params.lisp +++ b/src/params.lisp @@ -12,6 +12,7 @@ #:*client-min-messages* #:*log-min-messages* #:*report-stream* + #:*identifier-case* #:*copy-batch-rows* #:*copy-batch-size* #:*concurrent-batches* @@ -94,6 +95,12 @@ (defparameter *report-stream* *terminal-io* "Stream where to format the output stream.") +;;; +;;; When converting from other databases, how to deal with case sensitivity? +;;; +(defparameter *identifier-case* :downcase + "Dealing with source databases casing rules.") + ;;; ;;; How to split batches in case of data loading errors. ;;; diff --git a/src/parsers/command-dbf.lisp b/src/parsers/command-dbf.lisp index 0711d76..52c6aff 100644 --- a/src/parsers/command-dbf.lisp +++ b/src/parsers/command-dbf.lisp @@ -67,6 +67,7 @@ (state-after ,(when after `(pgloader.utils:make-pgstate))) ,@(pgsql-connection-bindings pg-db-uri gucs) ,@(batch-control-bindings options) + ,@(identifier-case-binding options) (source ,(bind (((kind url) source)) (ecase kind diff --git a/src/parsers/command-ixf.lisp b/src/parsers/command-ixf.lisp index 276e8e4..95126ea 100644 --- a/src/parsers/command-ixf.lisp +++ b/src/parsers/command-ixf.lisp @@ -43,6 +43,7 @@ (state-after ,(when after `(pgloader.utils:make-pgstate))) ,@(pgsql-connection-bindings pg-db-uri gucs) ,@(batch-control-bindings options) + ,@(identifier-case-binding options) (source ,(bind (((kind url) source)) (ecase kind diff --git a/src/parsers/command-mssql.lisp b/src/parsers/command-mssql.lisp index 7bcc051..70320bc 100644 --- a/src/parsers/command-mssql.lisp +++ b/src/parsers/command-mssql.lisp @@ -97,6 +97,7 @@ ,@(mssql-connection-bindings ms-db-uri) ,@(pgsql-connection-bindings pg-db-uri gucs) ,@(batch-control-bindings options) + ,@(identifier-case-binding options) (source (make-instance 'pgloader.mssql::copy-mssql :target-db ,pgdb diff --git a/src/parsers/command-mysql.lisp b/src/parsers/command-mysql.lisp index 5ddbf4b..04f93ec 100644 --- a/src/parsers/command-mysql.lisp +++ b/src/parsers/command-mysql.lisp @@ -181,6 +181,7 @@ ,@(mysql-connection-bindings my-db-uri) ,@(pgsql-connection-bindings pg-db-uri gucs) ,@(batch-control-bindings options) + ,@(identifier-case-binding options) (source (make-instance 'pgloader.mysql::copy-mysql :target-db ,pgdb diff --git a/src/parsers/command-options.lisp b/src/parsers/command-options.lisp index 9636f30..338125e 100644 --- a/src/parsers/command-options.lisp +++ b/src/parsers/command-options.lisp @@ -72,11 +72,16 @@ (*copy-batch-size* (or ,(getf options :batch-size) *copy-batch-size*)) (*concurrent-batches* (or ,(getf options :batch-concurrency) *concurrent-batches*)))) +(defun identifier-case-binding (options) + "Generate the code needed to bind *identifer-case* to the proper value." + `((*identifier-case* (or ,(getf options :identifier-case) *identifier-case*)))) + (defun remove-batch-control-option (options &key (option-list '(:batch-rows :batch-size - :batch-concurrency)) + :batch-concurrency + :identifier-case)) extras) "Given a list of options, remove the generic ones that should already have been processed." diff --git a/src/pgsql/schema.lisp b/src/pgsql/schema.lisp index e35308b..8d564e1 100644 --- a/src/pgsql/schema.lisp +++ b/src/pgsql/schema.lisp @@ -6,9 +6,9 @@ (defvar *pgsql-reserved-keywords* nil "We need to always quote PostgreSQL reserved keywords") -(defun apply-identifier-case (identifier case) +(defun apply-identifier-case (identifier) "Return given IDENTIFIER with CASE handled to be PostgreSQL compatible." - (ecase case + (ecase *identifier-case* (:downcase (let ((lowered (cl-ppcre:regex-replace-all "[^a-zA-Z0-9.]" (string-downcase identifier) "_"))) (if (member lowered *pgsql-reserved-keywords* :test #'string=) @@ -24,20 +24,20 @@ ;;; (defstruct pgsql-column name type-name type-mod nullable default) -(defgeneric format-pgsql-column (col &key identifier-case) +(defgeneric format-pgsql-column (col) (:documentation "Return the PostgreSQL column definition (type, default, not null, ...)")) -(defgeneric format-extra-type (col &key identifier-case include-drop) +(defgeneric format-extra-type (col &key include-drop) (:documentation "Return a list of PostgreSQL commands to create an extra type for given column, or nil of none is required. If no special extra type is ever needed, it's allowed not to specialize this generic into a method.")) -(defmethod format-pgsql-column ((col pgsql-column) &key identifier-case) +(defmethod format-pgsql-column ((col pgsql-column)) "Return a string representing the PostgreSQL column definition." (let* ((column-name - (apply-identifier-case (pgsql-column-name col) identifier-case)) + (apply-identifier-case (pgsql-column-name col))) (type-definition (format nil "~a~@[~a~]~:[~; not null~]~@[ default ~a~]" @@ -47,9 +47,9 @@ (pgsql-column-default col)))) (format nil "~a ~22t ~a" column-name type-definition))) -(defmethod format-extra-type ((col T) &key identifier-case include-drop) +(defmethod format-extra-type ((col T) &key include-drop) "The default `format-extra-type' implementation returns an empty list." - (declare (ignorable identifier-case include-drop)) + (declare (ignorable include-drop)) nil) @@ -60,30 +60,24 @@ (defstruct pgsql-fkey name table-name columns foreign-table foreign-columns) -(defgeneric format-pgsql-create-fkey (fkey &key identifier-case) +(defgeneric format-pgsql-create-fkey (fkey) (:documentation "Return the PostgreSQL command to define a Foreign Key Constraint.")) -(defgeneric format-pgsql-drop-fkey (fkey &key identifier-case) +(defgeneric format-pgsql-drop-fkey (fkey &key) (:documentation "Return the PostgreSQL command to DROP a Foreign Key Constraint.")) -(defmethod format-pgsql-create-fkey ((fk pgsql-fkey) &key identifier-case) +(defmethod format-pgsql-create-fkey ((fk pgsql-fkey)) "Generate the PostgreSQL statement to rebuild a MySQL Foreign Key" - (let* ((constraint-name - (apply-identifier-case (pgsql-fkey-name fk) identifier-case)) - (table-name - (apply-identifier-case (pgsql-fkey-table-name fk) identifier-case)) - (fkey-columns - (mapcar (lambda (column-name) - (apply-identifier-case column-name identifier-case)) - (pgsql-fkey-columns fk))) - (foreign-table - (apply-identifier-case (pgsql-fkey-foreign-table fk) identifier-case)) - (foreign-columns - (mapcar (lambda (column-name) - (apply-identifier-case column-name identifier-case)) - (pgsql-fkey-foreign-columns fk)))) + (let* ((constraint-name (apply-identifier-case (pgsql-fkey-name fk))) + (table-name (apply-identifier-case (pgsql-fkey-table-name fk))) + (fkey-columns (mapcar (lambda (column-name) + (apply-identifier-case column-name)) + (pgsql-fkey-columns fk))) + (foreign-table (apply-identifier-case (pgsql-fkey-foreign-table fk))) + (foreign-columns (mapcar #'apply-identifier-case + (pgsql-fkey-foreign-columns fk)))) (format nil "ALTER TABLE ~a ADD CONSTRAINT ~a FOREIGN KEY(~{~a~^,~}) REFERENCES ~a(~{~a~^,~})" table-name @@ -92,13 +86,10 @@ foreign-table foreign-columns))) -(defmethod format-pgsql-drop-fkey ((fk pgsql-fkey) - &key all-pgsql-fkeys identifier-case) +(defmethod format-pgsql-drop-fkey ((fk pgsql-fkey) &key all-pgsql-fkeys) "Generate the PostgreSQL statement to rebuild a MySQL Foreign Key" - (let* ((constraint-name - (apply-identifier-case (pgsql-fkey-name fk) identifier-case)) - (table-name - (apply-identifier-case (pgsql-fkey-table-name fk) identifier-case)) + (let* ((constraint-name (apply-identifier-case (pgsql-fkey-name fk))) + (table-name (apply-identifier-case (pgsql-fkey-table-name fk))) (fkeys (cdr (assoc table-name all-pgsql-fkeys :test #'string=))) (fkey-exists (member constraint-name fkeys :test #'string=))) (when fkey-exists @@ -110,32 +101,31 @@ ;;; ;;; Table schema rewriting support ;;; -(defun create-table-sql (table-name cols &key if-not-exists identifier-case) +(defun create-table-sql (table-name cols &key if-not-exists) "Return a PostgreSQL CREATE TABLE statement from given COLS. Each element of the COLS list is expected to be of a type handled by the `format-pgsql-column' generic function." (with-output-to-string (s) - (let ((table-name (apply-identifier-case table-name identifier-case))) + (let ((table-name (apply-identifier-case table-name))) (format s "CREATE TABLE~:[~; IF NOT EXISTS~] ~a ~%(~%" if-not-exists table-name)) (loop for (col . last?) on cols - for pg-coldef = (format-pgsql-column col :identifier-case identifier-case) + for pg-coldef = (format-pgsql-column col) do (format s " ~a~:[~;,~]~%" pg-coldef last?)) (format s ");~%"))) -(defun drop-table-if-exists-sql (table-name &key identifier-case) +(defun drop-table-if-exists-sql (table-name) "Return the PostgreSQL DROP TABLE IF EXISTS statement for TABLE-NAME." - (let ((table-name (apply-identifier-case table-name identifier-case))) + (let ((table-name (apply-identifier-case table-name))) (format nil "DROP TABLE IF EXISTS ~a;~%" table-name))) (defun create-table-sql-list (all-columns &key if-not-exists - include-drop - (identifier-case :downcase)) + include-drop) "Return the list of CREATE TABLE statements to run against PostgreSQL. The ALL-COLUMNS parameter must be a list of alist associations where the @@ -146,23 +136,18 @@ for (table-name . cols) in all-columns for extra-types = (loop for col in cols append (format-extra-type col - :identifier-case identifier-case :include-drop include-drop)) when include-drop - collect (drop-table-if-exists-sql table-name - :identifier-case identifier-case) + collect (drop-table-if-exists-sql table-name) when extra-types append extra-types - collect (create-table-sql table-name cols - :if-not-exists if-not-exists - :identifier-case identifier-case))) + collect (create-table-sql table-name cols :if-not-exists if-not-exists))) (defun create-tables (all-columns &key if-not-exists - (identifier-case :downcase) include-drop (client-min-messages :notice)) "Create all tables in database dbname in PostgreSQL. @@ -174,7 +159,6 @@ (loop for sql in (create-table-sql-list all-columns :if-not-exists if-not-exists - :identifier-case identifier-case :include-drop include-drop) count (not (null sql)) into nb-tables when sql @@ -183,15 +167,13 @@ (pgsql-execute sql :client-min-messages client-min-messages) finally (return nb-tables))) -(defun truncate-tables (dbname table-name-list - &key (identifier-case :downcase)) +(defun truncate-tables (dbname table-name-list) "Truncate given TABLE-NAME in database DBNAME" (with-pgsql-transaction (:dbname dbname) (set-session-gucs *pg-settings*) (let ((sql (format nil "TRUNCATE ~{~a~^,~};" (loop :for table-name :in table-name-list - :collect (apply-identifier-case table-name - identifier-case))))) + :collect (apply-identifier-case table-name))))) (log-message :notice "~a" sql) (pomo:execute sql)))) @@ -205,27 +187,22 @@ (:documentation "Return the name of the table to attach this index to.")) -(defgeneric format-pgsql-create-index (index &key identifier-case) +(defgeneric format-pgsql-create-index (index) (:documentation "Return the PostgreSQL command to define an Index.")) (defmethod index-table-name ((index pgsql-index)) (pgsql-index-table-name index)) -(defmethod format-pgsql-create-index ((index pgsql-index) &key identifier-case) +(defmethod format-pgsql-create-index ((index pgsql-index)) "Generate the PostgreSQL statement to rebuild a MySQL Foreign Key" (let* ((index-name (format nil "idx_~a_~a" (pgsql-index-table-oid index) (pgsql-index-name index))) - (table-name - (apply-identifier-case (pgsql-index-table-name index) identifier-case)) + (table-name (apply-identifier-case (pgsql-index-table-name index))) + (index-name (apply-identifier-case index-name)) - (index-name - (apply-identifier-case index-name identifier-case)) - - (cols - (mapcar (lambda (col) (apply-identifier-case col identifier-case)) - (pgsql-index-columns index)))) + (cols (mapcar #'apply-identifier-case (pgsql-index-columns index)))) (cond ((pgsql-index-primary index) (format nil @@ -243,7 +220,7 @@ ;;; (defun create-indexes-in-kernel (dbname indexes kernel channel &key - identifier-case state + state (label "Create Indexes")) "Create indexes for given table in dbname, using given lparallel KERNEL and CHANNEL so that the index build happen in concurrently with the data @@ -256,7 +233,7 @@ for index in indexes do (let ((sql - (format-pgsql-create-index index :identifier-case identifier-case))) + (format-pgsql-create-index index))) (when sql (log-message :notice "~a" sql) (lp:submit-task channel diff --git a/src/sources/db3.lisp b/src/sources/db3.lisp index 6072c73..86fd35d 100644 --- a/src/sources/db3.lisp +++ b/src/sources/db3.lisp @@ -15,10 +15,10 @@ (:constructor make-db3-field (name type length))) name type length) -(defmethod format-pgsql-column ((col db3-field) &key identifier-case) +(defmethod format-pgsql-column ((col db3-field)) "Return a string representing the PostgreSQL column definition." (let* ((column-name - (apply-identifier-case (db3-field-name col) identifier-case)) + (apply-identifier-case (db3-field-name col))) (type-definition (cdr (assoc (db3-field-type col) *db3-pgsql-type-mapping* diff --git a/src/sources/ixf.lisp b/src/sources/ixf.lisp index f608156..b834203 100644 --- a/src/sources/ixf.lisp +++ b/src/sources/ixf.lisp @@ -24,10 +24,9 @@ "Return the PostgreSQL type name for a given IXF type name." (cdr (assoc ixf-type *ixf-pgsql-type-mapping*))) -(defmethod format-pgsql-column ((col ixf:ixf-column) &key identifier-case) +(defmethod format-pgsql-column ((col ixf:ixf-column)) "Return a string reprensenting the PostgreSQL column definition" - (let* ((column-name (apply-identifier-case (ixf:ixf-column-name col) - identifier-case)) + (let* ((column-name (apply-identifier-case (ixf:ixf-column-name col))) (type-definition (format nil "~a~:[ not null~;~]~:[~*~; default ~a~]" diff --git a/src/sources/mssql.lisp b/src/sources/mssql.lisp index c97d51a..6a6e06b 100644 --- a/src/sources/mssql.lisp +++ b/src/sources/mssql.lisp @@ -119,7 +119,6 @@ (create-indexes t) (reset-sequences t) (foreign-keys t) - (identifier-case :downcase) (encoding :utf-8) only-tables) "Stream the given MS SQL database down to PostgreSQL." @@ -156,8 +155,7 @@ :summary summary) (with-pgsql-transaction () (loop :for (schema . tables) :in all-columns - :do (let ((schema - (apply-identifier-case schema identifier-case))) + :do (let ((schema (apply-identifier-case schema))) ;; create schema (let ((sql (format nil "CREATE SCHEMA ~a;" schema))) (log-message :notice "~a" sql) @@ -168,18 +166,14 @@ (format nil "SET LOCAL search_path TO ~a;" schema)) ;; and now create the tables within that schema - (create-tables tables - :include-drop include-drop - :identifier-case identifier-case)))))) + (create-tables tables :include-drop include-drop)))))) (truncate (let ((qualified-table-name-list - (qualified-table-name-list all-columns - :identifier-case identifier-case))) + (qualified-table-name-list all-columns))) (truncate-tables (target-db mssql) ;; here we really do want only the name - (mapcar #'car qualified-table-name-list) - :identifier-case identifier-case)))) + (mapcar #'car qualified-table-name-list))))) ;; Transfert the data (loop :for (schema . tables) :in all-columns @@ -190,9 +184,7 @@ :source-db (source-db mssql) :target-db (target-db mssql) :source (cons schema table-name) - :target (qualify-name schema table-name - :identifier-case - identifier-case) + :target (qualify-name schema table-name) :fields columns))) (log-message :debug "TARGET: ~a" (target table-source)) (log-message :log "target: ~s" table-source) diff --git a/src/sources/mssql/mssql-cast-rules.lisp b/src/sources/mssql/mssql-cast-rules.lisp index 7ef4be5..8e16f0e 100644 --- a/src/sources/mssql/mssql-cast-rules.lisp +++ b/src/sources/mssql/mssql-cast-rules.lisp @@ -90,10 +90,9 @@ (t type)))) -(defmethod format-pgsql-column ((col mssql-column) &key identifier-case) +(defmethod format-pgsql-column ((col mssql-column)) "Return a string representing the PostgreSQL column definition." - (let* ((column-name - (apply-identifier-case (mssql-column-name col) identifier-case)) + (let* ((column-name (apply-identifier-case (mssql-column-name col))) (type-definition (with-slots (schema table-name name type default nullable) col diff --git a/src/sources/mssql/mssql-schema.lisp b/src/sources/mssql/mssql-schema.lisp index c95fed0..e44dbd4 100644 --- a/src/sources/mssql/mssql-schema.lisp +++ b/src/sources/mssql/mssql-schema.lisp @@ -40,20 +40,17 @@ ;;; - where tables is an alist of (name . cols) ;;; - where cols is a list of mssql-column struct instances ;;; -(defun qualify-name (schema table-name &key (identifier-case :downcase)) +(defun qualify-name (schema table-name) "Return the fully qualified name." - (let ((sn (apply-identifier-case schema identifier-case)) - (tn (apply-identifier-case table-name identifier-case))) + (let ((sn (apply-identifier-case schema)) + (tn (apply-identifier-case table-name))) (format nil "~a.~a" sn tn))) -(defun qualified-table-name-list (schema-table-cols-alist - &key (identifier-case :downcase)) +(defun qualified-table-name-list (schema-table-cols-alist) "Return a flat list of qualified table names." (loop :for (schema . tables) :in schema-table-cols-alist :append (loop :for (table . cols) :in tables - :collect (cons (qualify-name schema table - :identifier-case identifier-case) - cols)))) + :collect (cons (qualify-name schema table) cols)))) ;;; @@ -141,27 +138,35 @@ order by table_schema, table_name, ordinal_position" "Get the list of MSSQL index definitions per table." (loop :with result := nil - :for (schema table-name name unique col) - :in - (mssql:query (format nil " -SELECT OBJECT_SCHEMA_NAME(T.[object_id],DB_ID()) AS [Schema], - T.[name] AS [table_name], I.[name] AS [index_name], AC.[name] AS [column_name], - I.[type_desc], I.[is_unique], I.[data_space_id], I.[ignore_dup_key], I.[is_primary_key], - I.[is_unique_constraint], I.[fill_factor], I.[is_padded], I.[is_disabled], I.[is_hypothetical], - I.[allow_row_locks], I.[allow_page_locks], IC.[is_descending_key], IC.[is_included_column] -FROM sys.[tables] AS T - INNER JOIN sys.[indexes] I ON T.[object_id] = I.[object_id] - INNER JOIN sys.[index_columns] IC ON I.[object_id] = IC.[object_id] - INNER JOIN sys.[all_columns] AC ON T.[object_id] = AC.[object_id] AND IC.[column_id] = AC.[column_id] -WHERE T.[is_ms_shipped] = 0 AND I.[type_desc] <> 'HEAP' -ORDER BY T.[name], I.[index_id], IC.[key_ordinal];") - :connection *mssql-db*) + :for (schema table-name name col unique pkey) + :in (mssql-query (format nil " + select schema_name(schema_id) as SchemaName + o.name as TableName, + i.name as IndexName, + ic.key_ordinal as ColumnOrder, + ic.is_included_column as IsIncluded, + co.[name] as ColumnName, + i.is_unique, + i.is_primary_key + + from sys.indexes i + join sys.objects o on i.object_id = o.object_id + join sys.index_columns ic on ic.object_id = i.object_id + and ic.index_id = i.index_id + join sys.columns co on co.object_id = i.object_id + and co.column_id = ic.column_id + +order by SchemaName, + o.[name], + i.[name], + ic.is_included_column, + ic.key_ordinal")) :do (let* ((s-entry (assoc schema result :test 'equal)) - (i-entry (when s-entry - (assoc table-name (cdr s-entry) :test 'equal))) - (index - )) + (t-entry (when s-entry + (assoc table-name (cdr t-entry) :test 'equal))) + (index (when t-entry + (assoc name (cdr t-entry) :test 'equal)))) (if s-entry (if t-entry (push column (cdr t-entry)) diff --git a/src/sources/mysql.lisp b/src/sources/mysql.lisp index 2dce8d8..4576dca 100644 --- a/src/sources/mysql.lisp +++ b/src/sources/mysql.lisp @@ -167,7 +167,6 @@ materialize-views view-columns &key state - identifier-case foreign-keys include-drop) "Prepare the target PostgreSQL database: create tables casting datatypes @@ -187,32 +186,27 @@ ;; we need to first drop the Foreign Key Constraints, so that we ;; can DROP TABLE when asked (when (and foreign-keys include-drop) - (drop-pgsql-fkeys all-fkeys :identifier-case identifier-case)) + (drop-pgsql-fkeys all-fkeys)) ;; now drop then create tables and types, etc (prog1 - (create-tables all-columns - :identifier-case identifier-case - :include-drop include-drop) + (create-tables all-columns :include-drop include-drop) ;; MySQL allows the same index name being used against several ;; tables, so we add the PostgreSQL table OID in the index name, ;; to differenciate. Set the table oids now. - (set-table-oids all-indexes :identifier-case identifier-case) + (set-table-oids all-indexes) ;; We might have to MATERIALIZE VIEWS (when materialize-views - (create-tables view-columns - :identifier-case identifier-case - :include-drop include-drop)))))) + (create-tables view-columns :include-drop include-drop)))))) (defun complete-pgsql-database (all-columns all-fkeys &key state data-only foreign-keys - reset-sequences - identifier-case) + reset-sequences) "After loading the data into PostgreSQL, we can now reset the sequences and declare foreign keys." ;; @@ -222,9 +216,7 @@ ;; while CREATE INDEX statements are in flight (avoid locking). ;; (when reset-sequences - (reset-pgsql-sequences all-columns - :state state - :identifier-case identifier-case)) + (reset-pgsql-sequences all-columns :state state)) ;; ;; Foreign Key Constraints @@ -234,7 +226,7 @@ ;; and indexes are imported before doing that. ;; (when (and foreign-keys (not data-only)) - (create-pgsql-fkeys all-fkeys :state state :identifier-case identifier-case))) + (create-pgsql-fkeys all-fkeys :state state))) (defun fetch-mysql-metadata (&key state @@ -314,7 +306,6 @@ (create-indexes t) (reset-sequences t) (foreign-keys t) - (identifier-case :downcase) ; or :quote only-tables including excluding @@ -361,13 +352,10 @@ view-columns :state state-before :foreign-keys foreign-keys - :identifier-case identifier-case :include-drop include-drop)) (t (when truncate - (truncate-tables *pg-dbname* - (mapcar #'car all-columns) - :identifier-case identifier-case)))) + (truncate-tables *pg-dbname* (mapcar #'car all-columns))))) ;; ;; In case some error happens in the preparatory transaction, we ;; need to stop now and refrain from trying to load the data into @@ -405,8 +393,7 @@ :source-db dbname :target-db pg-dbname :source table-name - :target (apply-identifier-case table-name - identifier-case) + :target (apply-identifier-case table-name) :fields columns :encoding encoding))) @@ -429,8 +416,7 @@ (cdr (assoc table-name all-indexes :test #'string=)))) (create-indexes-in-kernel pg-dbname indexes idx-kernel idx-channel - :state idx-state - :identifier-case identifier-case))))) + :state idx-state))))) ;; now end the kernels (let ((lp:*kernel* copy-kernel)) (lp:end-kernel)) @@ -456,8 +442,7 @@ :state state-after :data-only data-only :foreign-keys foreign-keys - :reset-sequences reset-sequences - :identifier-case identifier-case) + :reset-sequences reset-sequences) ;; and report the total time spent on the operation (when summary diff --git a/src/sources/mysql/mysql-cast-rules.lisp b/src/sources/mysql/mysql-cast-rules.lisp index 4e254e0..da3cdf3 100644 --- a/src/sources/mysql/mysql-cast-rules.lisp +++ b/src/sources/mysql/mysql-cast-rules.lisp @@ -13,17 +13,15 @@ ("(?i)(?:ENUM|SET)\\s*\\((.*)\\)" ctype) (first (cl-csv:read-csv list :separator #\, :quote #\' :escape "\\")))) -(defun get-enum-type-name (table-name column-name identifier-case) +(defun get-enum-type-name (table-name column-name) "Return the Type Name we're going to use in PostgreSQL." - (apply-identifier-case (format nil "~a_~a" table-name column-name) - identifier-case)) + (apply-identifier-case (format nil "~a_~a" table-name column-name))) -(defun get-create-enum (table-name column-name ctype - &key (identifier-case :downcase)) +(defun get-create-enum (table-name column-name ctype) "Return a PostgreSQL CREATE ENUM TYPE statement from MySQL enum column." (with-output-to-string (s) (format s "CREATE TYPE ~a AS ENUM (~{'~a'~^, ~});" - (get-enum-type-name table-name column-name identifier-case) + (get-enum-type-name table-name column-name) (explode-mysql-enum ctype)))) (defun cast-enum (table-name column-name type ctype typemod) @@ -31,7 +29,7 @@ The type naming is hardcoded to be table-name_column-name" (declare (ignore type ctype typemod)) - (format nil "\"~a_~a\"" table-name column-name)) + (get-enum-type-name table-name column-name)) (defun cast-set (table-name column-name type ctype typemod) "Cast MySQL inline SET type to using a PostgreSQL ENUM Array. diff --git a/src/sources/mysql/mysql-schema.lisp b/src/sources/mysql/mysql-schema.lisp index 5cdb4e9..05a556b 100644 --- a/src/sources/mysql/mysql-schema.lisp +++ b/src/sources/mysql/mysql-schema.lisp @@ -16,18 +16,16 @@ (table-name name dtype ctype default nullable extra))) table-name name dtype ctype default nullable extra) -(defmethod format-pgsql-column ((col mysql-column) &key identifier-case) +(defmethod format-pgsql-column ((col mysql-column)) "Return a string representing the PostgreSQL column definition." - (let* ((column-name - (apply-identifier-case (mysql-column-name col) identifier-case)) + (let* ((column-name (apply-identifier-case (mysql-column-name col))) (type-definition (with-slots (table-name name dtype ctype default nullable extra) col (cast table-name name dtype ctype default nullable extra)))) (format nil "~a ~22t ~a" column-name type-definition))) -(defmethod format-extra-type ((col mysql-column) - &key identifier-case include-drop) +(defmethod format-extra-type ((col mysql-column) &key include-drop) "Return a string representing the extra needed PostgreSQL CREATE TYPE statement, if such is needed" (let ((dtype (mysql-column-dtype col))) @@ -37,14 +35,12 @@ (when include-drop (let* ((type-name (get-enum-type-name (mysql-column-table-name col) - (mysql-column-name col) - identifier-case))) + (mysql-column-name col)))) (format nil "DROP TYPE IF EXISTS ~a;" type-name))) (get-create-enum (mysql-column-table-name col) (mysql-column-name col) - (mysql-column-ctype col) - :identifier-case identifier-case))))) + (mysql-column-ctype col)))))) ;;; @@ -252,19 +248,18 @@ GROUP BY table_name, index_name;" for (name . indexes) in schema collect (cons name (reverse indexes))))))) -(defun set-table-oids (all-indexes &key identifier-case) +(defun set-table-oids (all-indexes) "MySQL allows using the same index name against separate tables, which PostgreSQL forbids. To get unicity in index names without running out of characters (we are allowed only 63), we use the table OID instead. This function grabs the table OIDs in the PostgreSQL database and update the definitions with them." - (let* ((table-names (mapcar #'(lambda (table-name) - (apply-identifier-case table-name identifier-case)) + (let* ((table-names (mapcar #'apply-identifier-case (mapcar #'car all-indexes))) (table-oids (pgloader.pgsql:list-table-oids table-names))) (loop for (table-name-raw . indexes) in all-indexes - for table-name = (apply-identifier-case table-name-raw identifier-case) + for table-name = (apply-identifier-case table-name-raw) for table-oid = (cdr (assoc table-name table-oids :test #'string=)) unless table-oid do (error "OID not found for ~s." table-name) do (loop for index in indexes @@ -326,15 +321,14 @@ GROUP BY table_name, index_name;" for (name . fks) in schema collect (cons name (reverse fks))))))) -(defun drop-pgsql-fkeys (all-fkeys &key (dbname *pg-dbname*) identifier-case) +(defun drop-pgsql-fkeys (all-fkeys &key (dbname *pg-dbname*)) "Drop all Foreign Key Definitions given, to prepare for a clean run." (let ((all-pgsql-fkeys (list-tables-and-fkeys dbname))) (loop for (table-name . fkeys) in all-fkeys do (loop for fkey in fkeys for sql = (format-pgsql-drop-fkey fkey - :all-pgsql-fkeys all-pgsql-fkeys - :identifier-case identifier-case) + :all-pgsql-fkeys all-pgsql-fkeys) when sql do (log-message :notice "~a;" sql) @@ -344,15 +338,13 @@ GROUP BY table_name, index_name;" &key (dbname *pg-dbname*) state - identifier-case (label "Foreign Keys")) "Actually create the Foreign Key References that where declared in the MySQL database" (pgstate-add-table state dbname label) (loop for (table-name . fkeys) in all-fkeys do (loop for fkey in fkeys - for sql = - (format-pgsql-create-fkey fkey :identifier-case identifier-case) + for sql = (format-pgsql-create-fkey fkey) do (log-message :notice "~a;" sql) (pgsql-execute-with-timing dbname "Foreign Keys" sql state)))) @@ -362,11 +354,11 @@ GROUP BY table_name, index_name;" ;;; Sequences ;;; (defun reset-pgsql-sequences (all-columns - &key (dbname *pg-dbname*) state identifier-case) + &key (dbname *pg-dbname*) state) "Reset all sequences created during this MySQL migration." (let ((tables (mapcar - (lambda (name) (apply-identifier-case name identifier-case)) + (lambda (name) (apply-identifier-case name)) (mapcar #'car all-columns)))) (log-message :notice "Reset sequences") (with-stats-collection ("Reset Sequences" diff --git a/src/sources/sqlite.lisp b/src/sources/sqlite.lisp index f3d57ec..01f4c7b 100644 --- a/src/sources/sqlite.lisp +++ b/src/sources/sqlite.lisp @@ -125,7 +125,6 @@ only-tables including excluding - (identifier-case :downcase) (encoding :utf-8)) "Stream the given SQLite database down to PostgreSQL." (let* ((summary (null *state*)) @@ -159,13 +158,10 @@ :state state-before :summary summary) (with-pgsql-transaction () - (create-tables all-columns - :include-drop include-drop - :identifier-case identifier-case)))) + (create-tables all-columns :include-drop include-drop)))) (truncate - (truncate-tables *pg-dbname* (mapcar #'car all-columns) - :identifier-case identifier-case))) + (truncate-tables *pg-dbname* (mapcar #'car all-columns)))) (loop for (table-name . columns) in all-columns diff --git a/src/sources/sqlite/sqlite-cast-rules.lisp b/src/sources/sqlite/sqlite-cast-rules.lisp index 1070fd4..8e8a57f 100644 --- a/src/sources/sqlite/sqlite-cast-rules.lisp +++ b/src/sources/sqlite/sqlite-cast-rules.lisp @@ -83,10 +83,9 @@ PostgreSQL bytea column." (string= "bytea" (cast-sqlite-column-definition-to-pgsql col))) -(defmethod format-pgsql-column ((col coldef) &key identifier-case) +(defmethod format-pgsql-column ((col coldef)) "Return a string representing the PostgreSQL column definition." - (let* ((column-name - (apply-identifier-case (coldef-name col) identifier-case)) + (let* ((column-name (apply-identifier-case (coldef-name col))) (type-definition (with-slots (table-name name dtype ctype nullable default) col diff --git a/src/sources/sqlite/sqlite-schema.lisp b/src/sources/sqlite/sqlite-schema.lisp index 7be6cf1..64a1d54 100644 --- a/src/sources/sqlite/sqlite-schema.lisp +++ b/src/sources/sqlite/sqlite-schema.lisp @@ -38,9 +38,8 @@ (defmethod index-table-name ((index sqlite-idx)) (sqlite-idx-table-name index)) -(defmethod format-pgsql-create-index ((index sqlite-idx) &key identifier-case) +(defmethod format-pgsql-create-index ((index sqlite-idx)) "Generate the PostgresQL statement to build the given SQLite index definition." - (declare (ignore identifier-case)) (sqlite-idx-sql index)) (defun list-all-indexes (&optional (db *sqlite-db*))