diff --git a/src/parsers/command-keywords.lisp b/src/parsers/command-keywords.lisp index 2038187..3cf76af 100644 --- a/src/parsers/command-keywords.lisp +++ b/src/parsers/command-keywords.lisp @@ -109,6 +109,7 @@ (def-keyword-rule "identifiers") (def-keyword-rule "including") (def-keyword-rule "excluding") + (def-keyword-rule "like") ;; option for loading from an archive (def-keyword-rule "archive") (def-keyword-rule "before") diff --git a/src/parsers/command-mssql.lisp b/src/parsers/command-mssql.lisp index 24074b7..79ab3da 100644 --- a/src/parsers/command-mssql.lisp +++ b/src/parsers/command-mssql.lisp @@ -19,6 +19,52 @@ (*msconn-pass* ,mspass) (*ms-dbname* ,msdb)))) + +;;; +;;; INCLUDING ONLY and EXCLUDING clauses for MS SQL +;;; +;;; There's no regexp matching on MS SQL, so we're going to just use the +;;; classic LIKE support here, as documented at: +;;; +;;; http://msdn.microsoft.com/en-us/library/ms187489(SQL.90).aspx +;;; +(defrule like-expression (and "'" (+ (not "'")) "'") + (:lambda (le) + (bind (((_ like _) le)) (text like)))) + +(defrule another-like-expression (and comma like-expression) + (:lambda (source) + (bind (((_ like) source)) like))) + +(defrule filter-list (and like-expression (* another-like-expression)) + (:lambda (source) + (destructuring-bind (filter1 filters) source + (list* filter1 filters)))) + +(defrule including-in-schema + (and kw-including kw-only kw-table kw-names kw-like filter-list + kw-in kw-schema quoted-namestring) + (:lambda (source) + (bind (((_ _ _ _ _ filter-list _ _ schema) source)) + (cons schema filter-list)))) + +(defrule including (and including-in-schema (* including-in-schema)) + (:lambda (source) + (destructuring-bind (inc1 incs) source + (cons :including (list* inc1 incs))))) + +(defrule excluding-in-schema + (and kw-excluding kw-table kw-names kw-like filter-list + kw-in kw-schema quoted-namestring) + (:lambda (source) + (bind (((_ _ _ _ filter-list _ _ schema) source)) + (cons schema filter-list)))) + +(defrule excluding (and excluding-in-schema (* excluding-in-schema)) + (:lambda (source) + (destructuring-bind (excl1 excls) source + (cons :excluding (list* excl1 excls))))) + ;;; ;;; Allow clauses to appear in any order @@ -27,7 +73,9 @@ gucs casts before-load - after-load)) + after-load + including + excluding)) (:lambda (clauses-list) (alexandria:alist-plist clauses-list))) @@ -80,7 +128,7 @@ (:lambda (source) (bind (((ms-db-uri pg-db-uri &key - gucs casts before after + gucs casts before after including excluding ((:mysql-options options))) source) ((&key ((:dbname msdb)) table-name @@ -111,6 +159,8 @@ :state-before state-before :state-after state-after :state-indexes state-idx + :including ',including + :excluding ',excluding ,@(remove-batch-control-option options)) ,(sql-code-block pgdb 'state-after after "after load") diff --git a/src/sources/mssql.lisp b/src/sources/mssql.lisp index 27dc42a..611102a 100644 --- a/src/sources/mssql.lisp +++ b/src/sources/mssql.lisp @@ -152,7 +152,7 @@ (let ((*identifier-case* :none)) (create-pgsql-fkeys all-fkeys :state state))))) -(defun fetch-mssql-metadata (&key state only-tables) +(defun fetch-mssql-metadata (&key state including excluding) "MS SQL introspection to prepare the migration." (let (all-columns all-indexes all-fkeys) (with-stats-collection ("fetch meta data" @@ -160,14 +160,14 @@ :use-result-as-read t :state state) (with-mssql-connection () - (setf all-columns (filter-column-list (list-all-columns) - :only-tables only-tables)) + (setf all-columns (list-all-columns :including including + :excluding excluding)) - (setf all-indexes (filter-column-list (list-all-indexes) - :only-tables only-tables)) + (setf all-indexes (list-all-indexes :including including + :excluding excluding)) - (setf all-fkeys (filter-column-list (list-all-fkeys) - :only-tables only-tables)) + (setf all-fkeys (list-all-fkeys :including including + :excluding excluding)) ;; return how many objects we're going to deal with in total ;; for stats collection @@ -195,12 +195,21 @@ (reset-sequences t) (foreign-keys t) (encoding :utf-8) - only-tables) + only-tables + including + excluding) "Stream the given MS SQL database down to PostgreSQL." + + ;; only-tables is part of the generic lambda list, but we don't use it + ;; here as we didn't implement forcing the schema in the table name, and + ;; splitting the schema name and table name for processing in list-all-* + ;; filtering functions + (declare (ignore only-tables)) + (let* ((summary (null *state*)) (*state* (or *state* (make-pgstate))) (idx-state (or state-indexes (make-pgstate))) - (state-before (or state-before (make-pgstate))) + (state-before (or state-before (make-pgstate))) (state-after (or state-after (make-pgstate))) (cffi:*default-foreign-encoding* encoding) (copy-kernel (make-kernel 2)) @@ -209,7 +218,8 @@ (destructuring-bind (&key all-columns all-indexes all-fkeys pkeys) ;; to prepare the run we need to fetch MS SQL meta-data (fetch-mssql-metadata :state state-before - :only-tables only-tables) + :including including + :excluding excluding) (let ((max-indexes (loop :for (schema . tables) :in all-indexes :maximizing (loop :for (table . indexes) :in tables diff --git a/src/sources/mssql/mssql-schema.lisp b/src/sources/mssql/mssql-schema.lisp index d7bf721..8ca1743 100644 --- a/src/sources/mssql/mssql-schema.lisp +++ b/src/sources/mssql/mssql-schema.lisp @@ -73,9 +73,23 @@ "Associate internal table type symbol with what's found in MS SQL information_schema.tables.table_type column.") +(defun filter-list-to-where-clause (filter-list + &optional + not + (schema-col "table_schema") + (table-col "table_name")) + "Given an INCLUDING or EXCLUDING clause, turn it into a MS SQL WHERE clause." + (loop :for (schema . table-name-list) :in filter-list + :append (mapcar (lambda (table-name) + (format nil "(~a = '~a' and ~a ~:[~;NOT ~]LIKE '~a')" + schema-col schema table-col not table-name)) + table-name-list))) + (defun list-all-columns (&key (dbname *ms-dbname*) (table-type :table) + including + excluding &aux (table-type-name (cdr (assoc table-type *table-type*)))) (loop @@ -109,10 +123,22 @@ where c.table_catalog = '~a' and t.table_type = '~a' + ~:[~*~;and (~{~a~^~&~10t or ~})~] + ~:[~*~;and (~{~a~^~&~10t and ~})~] order by table_schema, table_name, ordinal_position" dbname - table-type-name)) + table-type-name + including ; do we print the clause? + (filter-list-to-where-clause including + nil + "c.table_schema" + "c.table_name") + excluding ; do we print the clause? + (filter-list-to-where-clause excluding + t + "c.table_schema" + "c.table_name"))) :do (let* ((s-entry (assoc schema result :test 'equal)) (t-entry (when s-entry @@ -139,7 +165,7 @@ order by table_schema, table_name, ordinal_position" (reverse (loop :for (table-name . cols) :in tables :collect (cons table-name (reverse cols)))))))))) -(defun list-all-indexes () +(defun list-all-indexes (&key including excluding) "Get the list of MSSQL index definitions per table." (loop :with result := nil @@ -160,12 +186,26 @@ order by table_schema, table_name, ordinal_position" and co.column_id = ic.column_id where schema_name(schema_id) not in ('dto', 'sys') + ~:[~*~;and (~{~a~^ or ~})~] + ~:[~*~;and (~{~a~^ and ~})~] order by SchemaName, o.[name], i.[name], ic.is_included_column, - ic.key_ordinal")) + ic.key_ordinal" + including ; do we print the clause? + (filter-list-to-where-clause including + nil + "schema_name(schema_id)" + "o.name" + ) + excluding ; do we print the clause? + (filter-list-to-where-clause excluding + t + "schema_name(schema_id)" + "o.name" + ))) :do (let* ((s-entry (assoc schema result :test 'equal)) (t-entry (when s-entry @@ -207,7 +247,7 @@ order by SchemaName, (loop :for (schema . tables) :in result :collect (cons schema (reverse-indexes-cols tables)))))))) -(defun list-all-fkeys (&key (dbname *ms-dbname*)) +(defun list-all-fkeys (&key (dbname *ms-dbname*) including excluding) "Get the list of MSSQL index definitions per table." (loop :with result := nil @@ -239,9 +279,21 @@ order by SchemaName, AND KCU1.TABLE_SCHEMA NOT IN ('dto', 'sys') AND KCU2.TABLE_SCHEMA NOT IN ('dto', 'sys') -ORDER BY CONSTRAINT_NAME, KCU1.ORDINAL_POSITION -" - dbname dbname)) + ~:[~*~;and (~{~a~^ or ~})~] + ~:[~*~;and (~{~a~^ and ~})~] + +ORDER BY CONSTRAINT_NAME, KCU1.ORDINAL_POSITION" + dbname dbname + including ; do we print the clause? + (filter-list-to-where-clause including + nil + "kcu1.table_schema" + "kcu1.table_name") + excluding ; do we print the clause? + (filter-list-to-where-clause excluding + t + "kcu1.table_schema" + "kcu1.table_name"))) :do (let* ((s-entry (assoc schema result :test 'equal)) (t-entry (when s-entry