mirror of
https://github.com/dimitri/pgloader.git
synced 2026-05-05 02:46:10 +02:00
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.
This commit is contained in:
Dimitri Fontaine
parent
5b2fb40578
commit
5b87b1a85e
@ -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.
|
||||
;;;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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."
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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*
|
||||
|
||||
@ -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~]"
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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*))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user