mirrors/pgloader
1
0
Fork 0
mirror of https://github.com/dimitri/pgloader.git synced 2026-05-05 10:56:10 +02:00
Code Issues Projects Releases Wiki Activity

Cleanup schema data structure building.

Browse Source 
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.
This commit is contained in:
Dimitri Fontaine 2015-08-15 23:54:45 +02:00
parent 6fc40c4844
commit 56a89e9b53
6 changed files with 68 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pgloader.asd
View File

@ -118,6 +118,7 @@
((:module "common"
:components
((:file "api")
(:file "schema")
(:file "casting-rules")
(:file "files-and-pathnames")
(:file "project-fields")))

11
src/package.lisp
View File

@ -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

25
src/sources/common/schema.lisp Normal file
View File

@ -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)

82
src/sources/mssql/mssql-schema.lisp
View File

@ -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)))
;;;

29
src/sources/mysql/mysql-schema.lisp
View File

@ -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)))
;;;

7
src/sources/sqlite/sqlite-schema.lisp
View File

@ -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))))
;;;