diff --git a/pgloader.asd b/pgloader.asd index db21490..f7ee1a3 100644 --- a/pgloader.asd +++ b/pgloader.asd @@ -118,6 +118,7 @@ ((:module "common" :components ((:file "api") + (:file "schema") (:file "casting-rules") (:file "files-and-pathnames") (:file "project-fields"))) diff --git a/src/package.lisp b/src/package.lisp index 83faf4a..1703925 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -33,13 +33,19 @@ (defpackage #:pgloader.utils (:use #:cl #:pgloader.params) - (:import-from #:alexandria #:read-file-into-string) + (:import-from #:alexandria + #:appendf + #:read-file-into-string) (:import-from #:pgloader.monitor #:with-monitor #:*monitoring-queue* #:log-message) (:export #:with-monitor ; monitor + ;; bits from alexandria + #:appendf + #:read-file-into-string + ;; logs #:log-message @@ -149,6 +155,9 @@ #:copy-to #:copy-database + ;; common schema facilities + #:push-to-end + ;; file based utils for CSV, fixed etc #:with-open-file-or-stream #:get-pathname diff --git a/src/sources/common/schema.lisp b/src/sources/common/schema.lisp new file mode 100644 index 0000000..1a7a523 --- /dev/null +++ b/src/sources/common/schema.lisp @@ -0,0 +1,25 @@ +;;; +;;; Generic API for pgloader sources +;;; +(in-package :pgloader.sources) + +(defmacro push-to-end (item place) + `(setf ,place (nconc ,place (list ,item)))) + +;;; +;;; TODO: stop using anonymous data structures for database catalogs, +;;; currently list of alists of lists... the madness has found its way in +;;; lots of places tho. +;;; + +;;; +;;; A database catalog is a list of schema each containing a list of tables, +;;; each being a list of columns. +;;; +;;; Column structures details depend on the specific source type and are +;;; implemented in each source separately. +;;; +(defstruct schema name tables) +(defstruct table schema name qualified-name columns) + + diff --git a/src/sources/mssql/mssql-schema.lisp b/src/sources/mssql/mssql-schema.lisp index b677f0b..2c082f2 100644 --- a/src/sources/mssql/mssql-schema.lisp +++ b/src/sources/mssql/mssql-schema.lisp @@ -166,17 +166,10 @@ order by c.table_schema, c.table_name, c.ordinal_position" character-set-name collation-name))) (if s-entry (if t-entry - (push column (cdr t-entry)) - (push (cons table-name (list column)) (cdr s-entry))) - (push (cons schema (list (cons table-name (list column)))) result))) - :finally - ;; we did push, we need to reverse here - (return (reverse - (loop :for (schema . tables) :in result - :collect - (cons schema - (reverse (loop :for (table-name . cols) :in tables - :collect (cons table-name (reverse cols)))))))))) + (push-to-end column (cdr t-entry)) + (push-to-end (cons table-name (list column)) (cdr s-entry))) + (push-to-end (cons schema (list (cons table-name (list column)))) result))) + :finally (return result))) (defun list-all-indexes (&key including excluding) "Get the list of MSSQL index definitions per table." @@ -233,32 +226,15 @@ order by SchemaName, (if s-entry (if t-entry (if i-entry - (push col + (push-to-end col (pgloader.pgsql::pgsql-index-columns (cdr i-entry))) - (push (cons name index) (cdr t-entry))) - (push (cons table (list (cons name index))) (cdr s-entry))) - (push (cons schema - (list (cons table - (list (cons name index))))) result))) + (push-to-end (cons name index) (cdr t-entry))) + (push-to-end (cons table (list (cons name index))) (cdr s-entry))) + (push-to-end (cons schema + (list (cons table + (list (cons name index))))) result))) :finally - ;; we did push, we need to reverse here - (return - (labels ((reverse-index-cols (index) - (setf (pgloader.pgsql::pgsql-index-columns index) - (nreverse (pgloader.pgsql::pgsql-index-columns index))) - index) - - (reverse-indexes-cols (list-of-indexes) - (loop :for (name . index) :in list-of-indexes - :collect (cons name (reverse-index-cols index)))) - - (reverse-indexes-cols (list-of-tables) - (reverse - (loop :for (table . indexes) :in list-of-tables - :collect (cons table (reverse-indexes-cols indexes)))))) - (reverse - (loop :for (schema . tables) :in result - :collect (cons schema (reverse-indexes-cols tables)))))))) + (return result))) (defun list-all-fkeys (&key including excluding) "Get the list of MSSQL index definitions per table." @@ -323,35 +299,17 @@ ORDER BY KCU1.CONSTRAINT_NAME, KCU1.ORDINAL_POSITION" (if t-entry (if f-entry (let ((fkey (cdr f-entry))) - (push col (pgloader.pgsql::pgsql-fkey-columns fkey)) - (push fcol (pgloader.pgsql::pgsql-fkey-foreign-columns fkey))) - (push (cons name fkey) (cdr t-entry))) - (push (cons table (list (cons name fkey))) (cdr s-entry))) - (push (cons schema - (list (cons table - (list (cons name fkey))))) result))) + (push-to-end col (pgloader.pgsql::pgsql-fkey-columns fkey)) + (push-to-end fcol + (pgloader.pgsql::pgsql-fkey-foreign-columns fkey))) + (push-to-end (cons name fkey) (cdr t-entry))) + (push-to-end (cons table (list (cons name fkey))) (cdr s-entry))) + (push-to-end (cons schema + (list (cons table + (list (cons name fkey))))) result))) :finally ;; we did push, we need to reverse here - (return - (labels ((reverse-fkey-cols (fkey) - (setf (pgloader.pgsql::pgsql-fkey-columns fkey) - (nreverse (pgloader.pgsql::pgsql-fkey-columns fkey))) - (setf (pgloader.pgsql::pgsql-fkey-foreign-columns fkey) - (nreverse - (pgloader.pgsql::pgsql-fkey-foreign-columns fkey))) - fkey) - - (reverse-fkeys-cols (list-of-fkeys) - (loop :for (name . fkeys) :in list-of-fkeys - :collect (cons name (reverse-fkey-cols fkeys)))) - - (reverse-fkeys-cols (list-of-tables) - (reverse - (loop :for (table . fkeys) :in list-of-tables - :collect (cons table (reverse-fkeys-cols fkeys)))))) - (reverse - (loop :for (schema . tables) :in result - :collect (cons schema (reverse-fkeys-cols tables)))))))) + (return result))) ;;; diff --git a/src/sources/mysql/mysql-schema.lisp b/src/sources/mysql/mysql-schema.lisp index 517efe9..d1ca97a 100644 --- a/src/sources/mysql/mysql-schema.lisp +++ b/src/sources/mysql/mysql-schema.lisp @@ -208,15 +208,10 @@ order by table_name, ordinal_position" (column (make-mysql-column table-name name dtype ctype def-val nullable extra))) (if entry - (push column (cdr entry)) - (push (cons table-name (list column)) schema))) + (push-to-end column (cdr entry)) + (push-to-end (cons table-name (list column)) schema))) finally - ;; we did push, we need to reverse here - (return (loop - for name in (if only-tables only-tables - (reverse (mapcar #'car schema))) - for cols = (cdr (assoc name schema :test #'string=)) - collect (cons name (reverse cols)))))) + (return schema))) (defun list-all-indexes (&key only-tables @@ -250,13 +245,10 @@ GROUP BY table_name, index_name;" :unique (not (string= "1" non-unique)) :columns (sq:split-sequence #\, cols)))) (if entry - (push index (cdr entry)) - (push (cons table-name (list index)) schema))) + (push-to-end index (cdr entry)) + (push-to-end (cons table-name (list index)) schema))) finally - ;; we did push, we need to reverse here - (return (reverse (loop - for (name . indexes) in schema - collect (cons name (reverse indexes))))))) + (return schema))) ;;; ;;; MySQL Foreign Keys @@ -317,13 +309,10 @@ GROUP BY table_name, index_name;" :update-rule update-rule :delete-rule delete-rule))) (if entry - (push fk (cdr entry)) - (push (cons table-name (list fk)) schema))) + (push-to-end fk (cdr entry)) + (push-to-end (cons table-name (list fk)) schema))) finally - ;; we did push, we need to reverse here - (return (reverse (loop - for (name . fks) in schema - collect (cons name (reverse fks))))))) + (return schema))) ;;; diff --git a/src/sources/sqlite/sqlite-schema.lisp b/src/sources/sqlite/sqlite-schema.lisp index 86374f3..3ef6005 100644 --- a/src/sources/sqlite/sqlite-schema.lisp +++ b/src/sources/sqlite/sqlite-schema.lisp @@ -55,10 +55,9 @@ :table-name table-name :sql sql))) (if entry - (push idxdef (cdr entry)) - (push (cons table-name (list idxdef)) schema))) - :finally (return (reverse (loop for (name . indexes) in schema - collect (cons name (reverse indexes)))))))) + (push-to-end idxdef (cdr entry)) + (push-to-end (cons table-name (list idxdef)) schema))) + :finally (return schema)))) ;;;