mirror of
https://github.com/dimitri/pgloader.git
synced 2025-08-08 23:37:00 +02:00
Implement support for MySQL comments, fix #126.
Only table (BASE TABLE) and columns comments are supported now. I didn't even try to see if more are possible and interesting to support.
This commit is contained in:
Dimitri Fontaine
parent
cd46b6cbed
commit
b403c40d30
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user