diff --git a/src/sources/mysql/mysql-schema.lisp b/src/sources/mysql/mysql-schema.lisp index ed7d488..a6c0748 100644 --- a/src/sources/mysql/mysql-schema.lisp +++ b/src/sources/mysql/mysql-schema.lisp @@ -313,6 +313,65 @@ GROUP BY table_name, index_name;" for (name . fks) in schema collect (cons name (reverse fks))))))) + +;;; +;;; Queries to get the MySQL comments. +;;; +;;; As it takes a separate PostgreSQL Query per comment it's useless to +;;; fetch them right into the the more general table and columns lists. +;;; +(defun list-table-comments (&key + only-tables + including + excluding) + "Return comments on MySQL tables." + (loop + :for (table-name comment) + :in (mysql-query (format nil " + SELECT table_name, table_comment + FROM information_schema.tables + WHERE table_schema = '~a' + and table_type = 'BASE TABLE' + ~:[~*~;and table_name in (~{'~a'~^,~})~] + ~:[~*~;and (~{table_name ~a~^ or ~})~] + ~:[~*~;and (~{table_name ~a~^ and ~})~]" + (db-name *connection*) + only-tables ; do we print the clause? + only-tables + including ; do we print the clause? + (filter-list-to-where-clause including) + excluding ; do we print the clause? + (filter-list-to-where-clause excluding t))) + :when (and comment (not (string= comment ""))) + :collect (list table-name comment))) + +(defun list-columns-comments (&key + only-tables + including + excluding) + "Return comments on MySQL tables." + (loop + :for (table-name column-name comment) + :in (mysql-query (format nil " + select c.table_name, c.column_name, c.column_comment + from information_schema.columns c + join information_schema.tables t using(table_schema, table_name) + where c.table_schema = '~a' + and t.table_type = 'BASE TABLE' + ~:[~*~;and table_name in (~{'~a'~^,~})~] + ~:[~*~;and (~{table_name ~a~^ or ~})~] + ~:[~*~;and (~{table_name ~a~^ and ~})~] +order by table_name, ordinal_position" + (db-name *connection*) + only-tables ; do we print the clause? + only-tables + including ; do we print the clause? + (filter-list-to-where-clause including) + excluding ; do we print the clause? + (filter-list-to-where-clause excluding t))) + :when (and comment (not (string= comment ""))) + :collect (list table-name column-name comment))) + ;;; ;;; Tools to handle row queries, issuing separate is null statements and diff --git a/src/sources/mysql/mysql.lisp b/src/sources/mysql/mysql.lisp index ab59ed7..2a18ae9 100644 --- a/src/sources/mysql/mysql.lisp +++ b/src/sources/mysql/mysql.lisp @@ -184,6 +184,7 @@ (create-tables view-columns :include-drop include-drop)))))) (defun complete-pgsql-database (pgconn all-columns all-fkeys pkeys + table-comments column-comments &key state data-only @@ -200,10 +201,10 @@ (when reset-sequences (reset-sequences (mapcar #'car all-columns) :pgconn pgconn :state state)) - ;; - ;; Turn UNIQUE indexes into PRIMARY KEYS now - ;; (with-pgsql-connection (pgconn) + ;; + ;; Turn UNIQUE indexes into PRIMARY KEYS now + ;; (pgstate-add-table state (db-name pgconn) "Primary Keys") (loop :for sql :in pkeys :when sql @@ -225,7 +226,44 @@ :for sql := (format-pgsql-create-fkey fkey) :do (progn (log-message :notice "~a;" sql) - (pgsql-execute-with-timing "Foreign Keys" sql state))))))) + (pgsql-execute-with-timing "Foreign Keys" sql state))))) + + ;; + ;; And now, comments on tables and columns. + ;; + (log-message :notice "Comments") + (pgstate-add-table state (db-name pgconn) "Comments") + (let* ((quote + ;; just something improbably found in a table comment, to use as + ;; dollar quoting, and generated at random at that. + ;; + ;; because somehow it appears impossible here to benefit from + ;; the usual SQL injection protection offered by the Extended + ;; Query Protocol from PostgreSQL. + (concatenate 'string + (map 'string #'code-char + (loop :repeat 5 + :collect (+ (random 26) (char-code #\A)))) + "-" + (map 'string #'code-char + (loop :repeat 5 + :collect (+ (random 26) (char-code #\A))))))) + (loop :for (table-name comment) :in table-comments + :for sql := (format nil "comment on table ~a is $~a$~a$~a$" + (apply-identifier-case table-name) + quote comment quote) + :do (progn + (log-message :log "~a" sql) + (pgsql-execute-with-timing "Comments" sql state))) + + (loop :for (table-name column-name comment) :in column-comments + :for sql := (format nil "comment on column ~a.~a is $~a$~a$~a$" + (apply-identifier-case table-name) + (apply-identifier-case column-name) + quote comment quote) + :do (progn + (log-message :notice "~a;" sql) + (pgsql-execute-with-timing "Comments" sql state)))))) (defun fetch-mysql-metadata (mysql &key @@ -237,7 +275,8 @@ "MySQL introspection to prepare the migration." (let ((view-names (unless (eq :all materialize-views) (mapcar #'car materialize-views))) - view-columns all-columns all-fkeys all-indexes) + view-columns all-columns all-fkeys all-indexes + table-comments column-comments) (with-stats-collection ("fetch meta data" :use-result-as-rows t :use-result-as-read t @@ -252,6 +291,14 @@ :including including :excluding excluding) + table-comments (list-table-comments :only-tables only-tables + :including including + :excluding excluding) + + column-comments (list-columns-comments :only-tables only-tables + :including including + :excluding excluding) + all-fkeys (list-all-fkeys :only-tables only-tables :including including :excluding excluding) @@ -274,6 +321,8 @@ ;; now return a plist to the caller (list :all-columns all-columns + :table-comments table-comments + :column-comments column-comments :all-fkeys all-fkeys :all-indexes all-indexes :view-columns view-columns))) @@ -320,7 +369,9 @@ (copy-kernel (make-kernel 2)) idx-kernel idx-channel) - (destructuring-bind (&key view-columns all-columns all-fkeys all-indexes pkeys) + (destructuring-bind (&key view-columns all-columns + table-comments column-comments + all-fkeys all-indexes pkeys) ;; to prepare the run, we need to fetch MySQL meta-data (fetch-mysql-metadata mysql :state state-before @@ -355,7 +406,7 @@ :include-drop include-drop)) (t (when truncate - (truncate-tables (pgconn-dbname) (mapcar #'car all-columns))))) + (truncate-tables (target-db mysql) (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 @@ -442,6 +493,7 @@ ;; (complete-pgsql-database (new-pgsql-connection (target-db mysql)) all-columns all-fkeys pkeys + table-comments column-comments :state state-after :data-only data-only :foreign-keys foreign-keys