From 56a89e9b53e74d51b99248e4aacd4cc4d5dc8154 Mon Sep 17 00:00:00 2001 From: Dimitri Fontaine Date: Sat, 15 Aug 2015 23:54:45 +0200 Subject: [PATCH] Cleanup schema data structure building. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit As reported by clisp maintainer (thanks jackdaniel!) when trying to load pgloader, we had redoundant labels function names in places. Get rid of those by pushing the new columns found directly at the end of the list, avoiding the bulky code to then reverse the complex anonymous data structure. The Real Fix™ would be to define proper structures where to hold all those database catalogs representation, but that's an invasive patch and now isn't a good time to write it. At least pgloader should load and run with clisp now. --- pgloader.asd | 1 + src/package.lisp | 11 +++- src/sources/common/schema.lisp | 25 ++++++++ src/sources/mssql/mssql-schema.lisp | 82 +++++++-------------------- src/sources/mysql/mysql-schema.lisp | 29 +++------- src/sources/sqlite/sqlite-schema.lisp | 7 +-- 6 files changed, 68 insertions(+), 87 deletions(-) create mode 100644 src/sources/common/schema.lisp 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)))) ;;;