File: /var/www/html/mysql-postgres/pgloader-3.6.2/src/sources/mysql/mysql-schema.lisp
;;;
;;; Tools to query the MySQL Schema to reproduce in PostgreSQL
;;;
(in-package :pgloader.source.mysql)
(defclass copy-mysql (db-copy)
((encoding :accessor encoding ; allows forcing encoding
:initarg :encoding
:initform nil)
(range-list :accessor range-list
:initarg :range-list
:initform nil))
(:documentation "pgloader MySQL Data Source"))
;;;
;;; Those functions are to be called from withing an already established
;;; MySQL Connection.
;;;
;;; Tools to get MySQL table and columns definitions and transform them to
;;; PostgreSQL CREATE TABLE statements, and run those.
;;;
(defvar *table-type* '((:table . "BASE TABLE")
(:view . "VIEW"))
"Associate internal table type symbol with what's found in MySQL
information_schema.tables.table_type column.")
(defmethod filter-list-to-where-clause ((mysql copy-mysql) filter-list
&key not &allow-other-keys)
"Given an INCLUDING or EXCLUDING clause, turn it into a MySQL WHERE clause."
(declare (ignore mysql))
(mapcar (lambda (filter)
(typecase filter
(string-match-rule
(format nil "~:[~;!~]= '~a'"
not
(string-match-rule-target filter)))
(regex-match-rule
(format nil "~:[~;NOT ~]REGEXP '~a'"
not
(regex-match-rule-target filter)))))
filter-list))
(defun cleanup-default-value (dtype default)
"MySQL catalog query always returns the default value as a string, but in
the case of a binary data type we actually want a byte vector."
(cond ((string= "binary" dtype)
(when default
(babel:string-to-octets default)))
(t (ensure-unquoted default #\'))))
(defmethod fetch-columns ((schema schema)
(mysql copy-mysql)
&key
(table-type :table)
including
excluding
&aux
(table-type-name
(cdr (assoc table-type *table-type*))))
"Get the list of MySQL column names per table."
(loop
:for (tname tcomment cname ccomment dtype ctype default nullable extra)
:in (mysql-query (sql "/mysql/list-all-columns.sql"
(db-name *connection*)
table-type-name
including ; do we print the clause?
including
excluding ; do we print the clause?
excluding))
:do
(let* ((table
(case table-type
(:view (maybe-add-view schema tname :comment tcomment))
(:table (maybe-add-table schema tname :comment tcomment))))
(def-val (cleanup-default-value dtype default))
(field (make-mysql-column
tname cname (unless (or (null ccomment)
(string= "" ccomment))
ccomment)
dtype ctype def-val nullable
(normalize-extra extra))))
(add-field table field))
:finally
(return schema)))
(defmethod fetch-indexes ((schema schema) (mysql copy-mysql)
&key including excluding)
"Get the list of MySQL index definitions per table."
(loop
:for (table-name name index-type non-unique cols)
:in (mysql-query (sql "/mysql/list-all-indexes.sql"
(db-name *connection*)
including ; do we print the clause?
including
excluding ; do we print the clause?
excluding))
:do (let* ((table (find-table schema table-name))
(index
(make-index :name name ; further processing is needed
:schema schema
:table table
:type index-type
:primary (string= name "PRIMARY")
:unique (string= "0" non-unique)
:columns (mapcar
#'apply-identifier-case
(sq:split-sequence #\, cols)))))
(add-index table index))
:finally
(return schema)))
;;;
;;; MySQL Foreign Keys
;;;
(defmethod fetch-foreign-keys ((schema schema)
(mysql copy-mysql)
&key
including
excluding)
"Get the list of MySQL Foreign Keys definitions per table."
(loop
:for (table-name name ftable-name cols fcols update-rule delete-rule)
:in (mysql-query (sql "/mysql/list-all-fkeys.sql"
(db-name *connection*) (db-name *connection*)
including ; do we print the clause?
including
excluding ; do we print the clause?
excluding))
:do (let* ((table (find-table schema table-name))
(ftable (find-table schema ftable-name))
(fk
(make-fkey :name (apply-identifier-case name)
:table table
:columns (mapcar #'apply-identifier-case
(sq:split-sequence #\, cols))
:foreign-table ftable
:foreign-columns (mapcar
#'apply-identifier-case
(sq:split-sequence #\, fcols))
:update-rule update-rule
:delete-rule delete-rule)))
(if (and name table ftable)
(add-fkey table fk)
;; chances are this comes from the EXCLUDING clause, but
;; we'll make for it in fetching missing dependencies for
;; (unique) indexes
(log-message :info
"Incomplete Foreign Key definition: constraint ~s on table ~s referencing table ~s"
name
(when table (format-table-name table))
(when ftable (format-table-name ftable)))))
:finally
(return schema)))
;;;
;;; 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 including excluding)
"Return comments on MySQL tables."
(loop
:for (table-name comment)
:in (mysql-query (sql "/mysql/list-table-comments.sql"
(db-name *connection*)
including ; do we print the clause?
including
excluding ; do we print the clause?
excluding))
:when (and comment (not (string= comment "")))
:collect (list table-name comment)))
(defun list-columns-comments (&key including excluding)
"Return comments on MySQL tables."
(loop
:for (table-name column-name comment)
:in (mysql-query (sql "/mysql/list-columns-comments.sql"
(db-name *connection*)
including ; do we print the clause?
including
excluding ; do we print the clause?
excluding))
:when (and comment (not (string= comment "")))
:collect (list table-name column-name comment)))
;;;
;;; Tools to handle row queries, issuing separate is null statements and
;;; handling of geometric data types.
;;;
(defmethod get-column-sql-expression ((mysql copy-mysql) name type)
"Return per-TYPE SQL expression to use given a column NAME.
Mostly we just use the name, but in case of POINT we need to use
st_astext(name)."
(declare (ignore mysql))
(case (intern (string-upcase type) "KEYWORD")
(:geometry (format nil "st_astext(`~a`) as `~a`" name name))
(:point (format nil "st_astext(`~a`) as `~a`" name name))
(:linestring (format nil "st_astext(`~a`) as `~a`" name name))
(t (format nil "`~a`" name))))
(defmethod get-column-list ((mysql copy-mysql))
"Some MySQL datatypes have a meaningless default output representation, we
need to process them on the SQL side (geometric data types)."
(loop :for field :in (fields mysql)
:collect (let ((name (mysql-column-name field))
(type (mysql-column-dtype field)))
(get-column-sql-expression mysql name type))))