From e37cb3a9e799992b1e9e28272ce9d63196045701 Mon Sep 17 00:00:00 2001 From: Dimitri Fontaine Date: Thu, 6 Jul 2017 02:59:02 +0200 Subject: [PATCH] Split SQL queries into their own files. This change was long overdue. Ideally we would use something like the YeSQL library for Clojure, but it seems like the cl-yesql equivalent is not ready yet, and it depends on an experimental build system... So this patch introduces an URL abstraction built on-top of a hash table. You can then reference src/pgsql/sql/list-all-columns.sql as (sql "pgsql/list-all-columns.sql") in the source code directly. So for now the templating system is CL's format language. It is still an improvement from embedded string. Again, one step at a time. --- pgloader.asd | 1 + src/package.lisp | 7 + src/pgsql/connection.lisp | 17 +- src/pgsql/pgsql-schema.lisp | 168 ++++-------------- src/pgsql/sql/list-all-columns.sql | 23 +++ src/pgsql/sql/list-all-fkeys.sql | 36 ++++ src/pgsql/sql/list-all-indexes.sql | 27 +++ src/pgsql/sql/list-missing-fk-deps.sql | 26 +++ src/pgsql/sql/list-table-oids.sql | 4 + .../list-typenames-without-btree-support.sql | 15 ++ src/pgsql/sql/query-table-schema.sql | 5 + src/sources/mssql/mssql-schema.lisp | 113 +----------- src/sources/mssql/sql/list-all-columns.sql | 50 ++++++ src/sources/mssql/sql/list-all-fkeys.sql | 37 ++++ src/sources/mssql/sql/list-all-indexes.sql | 28 +++ src/sources/mysql/mysql-schema.lisp | 95 ++-------- src/sources/mysql/sql/get-column-list.sql | 6 + src/sources/mysql/sql/list-all-columns.sql | 19 ++ src/sources/mysql/sql/list-all-fkeys.sql | 42 +++++ src/sources/mysql/sql/list-all-indexes.sql | 16 ++ .../mysql/sql/list-columns-comments.sql | 17 ++ src/sources/mysql/sql/list-table-comments.sql | 15 ++ src/utils/queries.lisp | 68 +++++++ 23 files changed, 502 insertions(+), 333 deletions(-) create mode 100644 src/pgsql/sql/list-all-columns.sql create mode 100644 src/pgsql/sql/list-all-fkeys.sql create mode 100644 src/pgsql/sql/list-all-indexes.sql create mode 100644 src/pgsql/sql/list-missing-fk-deps.sql create mode 100644 src/pgsql/sql/list-table-oids.sql create mode 100644 src/pgsql/sql/list-typenames-without-btree-support.sql create mode 100644 src/pgsql/sql/query-table-schema.sql create mode 100644 src/sources/mssql/sql/list-all-columns.sql create mode 100644 src/sources/mssql/sql/list-all-fkeys.sql create mode 100644 src/sources/mssql/sql/list-all-indexes.sql create mode 100644 src/sources/mysql/sql/get-column-list.sql create mode 100644 src/sources/mysql/sql/list-all-columns.sql create mode 100644 src/sources/mysql/sql/list-all-fkeys.sql create mode 100644 src/sources/mysql/sql/list-all-indexes.sql create mode 100644 src/sources/mysql/sql/list-columns-comments.sql create mode 100644 src/sources/mysql/sql/list-table-comments.sql create mode 100644 src/utils/queries.lisp diff --git a/pgloader.asd b/pgloader.asd index d0a8f20..2b57366 100644 --- a/pgloader.asd +++ b/pgloader.asd @@ -63,6 +63,7 @@ ;; PostgreSQL related utils (:file "read-sql-files") + (:file "queries") (:file "quoting") (:file "catalog" :depends-on ("quoting")) (:file "alter-table" :depends-on ("catalog")) diff --git a/src/package.lisp b/src/package.lisp index 8f3180c..d5bcaae 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -252,9 +252,15 @@ #:batch-oversized-p #:batch-full-p)) +(defpackage #:pgloader.queries + (:use #:cl #:pgloader.params) + (:export #:*queries* + #:sql)) + (defpackage #:pgloader.utils (:use #:cl #:pgloader.params + #:pgloader.queries #:pgloader.quoting #:pgloader.catalog #:pgloader.monitor @@ -285,6 +291,7 @@ #:show-encodings #:make-external-format)) +(cl-user::export-inherited-symbols "pgloader.queries" "pgloader.utils") (cl-user::export-inherited-symbols "pgloader.quoting" "pgloader.utils") (cl-user::export-inherited-symbols "pgloader.catalog" "pgloader.utils") (cl-user::export-inherited-symbols "pgloader.monitor" "pgloader.utils") diff --git a/src/pgsql/connection.lisp b/src/pgsql/connection.lisp index bab9586..ca1a8f3 100644 --- a/src/pgsql/connection.lisp +++ b/src/pgsql/connection.lisp @@ -343,22 +343,7 @@ to later CREATE INDEX ... ON ... USING gist(...), or even something else than gist. " (loop :for (typename access-methods) :in - (pomo:query " -select typname, - array_agg(amname order by amname <> 'gist', amname <> 'gin') - from pg_type - join pg_opclass on pg_opclass.opcintype = pg_type.oid - join pg_am on pg_am.oid = pg_opclass.opcmethod - where substring(typname from 1 for 1) <> '_' - and not exists - ( - select amname - from pg_am am - join pg_opclass c on am.oid = c.opcmethod - join pg_type t on c.opcintype = t.oid - where amname = 'btree' and t.oid = pg_type.oid - ) -group by typname;") + (pomo:query (sql "/pgsql/list-typenames-without-btree-support.sql")) :collect (cons typename access-methods))) (defun list-reserved-keywords (pgconn) diff --git a/src/pgsql/pgsql-schema.lisp b/src/pgsql/pgsql-schema.lisp index 9269b1c..a48b3a3 100644 --- a/src/pgsql/pgsql-schema.lisp +++ b/src/pgsql/pgsql-schema.lisp @@ -102,12 +102,10 @@ "Get PostgreSQL schema name where to locate TABLE-NAME by following the current search_path rules. A PostgreSQL connection must be opened." (make-schema :name - (pomo:query (format nil " - select nspname - from pg_namespace n - join pg_class c on n.oid = c.relnamespace - where c.oid = '~a'::regclass;" - (table-name table)) :single))) + (pomo:query (format nil + (sql "/pgsql/query-table-schema.sql") + (table-name table)) + :single))) (defvar *table-type* '((:table . "r") @@ -141,25 +139,8 @@ (loop :for (schema-name table-name table-oid name type typmod notnull default) :in (query nil - (format nil " - select nspname, relname, c.oid, attname, - t.oid::regtype as type, - case when atttypmod > 0 then atttypmod - 4 else null end as typmod, - attnotnull, - case when atthasdef then def.adsrc end as default - from pg_class c - join pg_namespace n on n.oid = c.relnamespace - left join pg_attribute a on c.oid = a.attrelid - join pg_type t on t.oid = a.atttypid and attnum > 0 - left join pg_attrdef def on a.attrelid = def.adrelid - and a.attnum = def.adnum - - where nspname !~~ '^pg_' and n.nspname <> 'information_schema' - and relkind = '~a' - ~:[~*~;and (~{~a~^~&~10t or ~})~] - ~:[~*~;and (~{~a~^~&~10t and ~})~] - - order by nspname, relname, attnum" + (format nil + (sql "/pgsql/list-all-columns.sql") table-type-name including ; do we print the clause? (filter-list-to-where-clause including @@ -189,30 +170,8 @@ table-schema table-name primary unique sql conname condef) :in (query nil - (format nil " - select n.nspname, - i.relname, - i.oid, - rn.nspname, - r.relname, - indisprimary, - indisunique, - pg_get_indexdef(indexrelid), - c.conname, - pg_get_constraintdef(c.oid) - from pg_index x - join pg_class i ON i.oid = x.indexrelid - join pg_class r ON r.oid = x.indrelid - join pg_namespace n ON n.oid = i.relnamespace - join pg_namespace rn ON rn.oid = r.relnamespace - left join pg_constraint c ON c.conindid = i.oid - and c.conrelid = r.oid - -- filter out self-fkeys - and c.confrelid <> r.oid - where n.nspname !~~ '^pg_' and n.nspname <> 'information_schema' - ~:[~*~;and (~{~a~^~&~10t or ~})~] - ~:[~*~;and (~{~a~^~&~10t and ~})~] -order by n.nspname, r.relname" + (format nil + (sql "/pgsql/list-all-indexes.sql") including ; do we print the clause? (filter-list-to-where-clause including nil @@ -247,57 +206,29 @@ order by n.nspname, r.relname" conoid conname condef cols fcols updrule delrule mrule deferrable deferred) - :in - (query nil - (format nil " - select n.nspname, c.relname, nf.nspname, cf.relname as frelname, - r.oid, conname, - pg_catalog.pg_get_constraintdef(r.oid, true) as condef, - (select string_agg(attname, ',') - from pg_attribute - where attrelid = r.conrelid - and array[attnum::integer] <@ conkey::integer[] - ) as conkey, - (select string_agg(attname, ',') - from pg_attribute - where attrelid = r.confrelid - and array[attnum::integer] <@ confkey::integer[] - ) as confkey, - confupdtype, confdeltype, confmatchtype, - condeferrable, condeferred - from pg_catalog.pg_constraint r - JOIN pg_class c on r.conrelid = c.oid - JOIN pg_namespace n on c.relnamespace = n.oid - JOIN pg_class cf on r.confrelid = cf.oid - JOIN pg_namespace nf on cf.relnamespace = nf.oid - where r.contype = 'f' - AND c.relkind = 'r' and cf.relkind = 'r' - AND n.nspname !~~ '^pg_' and n.nspname <> 'information_schema' - AND nf.nspname !~~ '^pg_' and nf.nspname <> 'information_schema' - ~:[~*~;and (~{~a~^~&~10t or ~})~] - ~:[~*~;and (~{~a~^~&~10t and ~})~] - ~:[~*~;and (~{~a~^~&~10t or ~})~] - ~:[~*~;and (~{~a~^~&~10t and ~})~]" - including ; do we print the clause (table)? - (filter-list-to-where-clause including - nil - "n.nspname" - "c.relname") - excluding ; do we print the clause (table)? - (filter-list-to-where-clause excluding - nil - "n.nspname" - "c.relname") - including ; do we print the clause (ftable)? - (filter-list-to-where-clause including - nil - "nf.nspname" - "cf.relname") - excluding ; do we print the clause (ftable)? - (filter-list-to-where-clause excluding - nil - "nf.nspname" - "cf.relname"))) + :in (query nil + (format nil + (sql "/pgsql/list-all-fkeys.sql") + including ; do we print the clause (table)? + (filter-list-to-where-clause including + nil + "n.nspname" + "c.relname") + excluding ; do we print the clause (table)? + (filter-list-to-where-clause excluding + nil + "n.nspname" + "c.relname") + including ; do we print the clause (ftable)? + (filter-list-to-where-clause including + nil + "nf.nspname" + "cf.relname") + excluding ; do we print the clause (ftable)? + (filter-list-to-where-clause excluding + nil + "nf.nspname" + "cf.relname"))) :do (flet ((pg-fk-rule-to-action (rule) (case rule (#\a "NO ACTION") @@ -350,31 +281,8 @@ order by n.nspname, r.relname" (loop :for (schema-name table-name fschema-name ftable-name conoid conname condef index-oid) :in (query nil - (format nil " -with pkeys(oid) as ( - values~{(~d)~^,~} -), - knownfkeys(oid) as ( - values~{(~d)~^,~} -), - pkdeps as ( - select pkeys.oid, pg_depend.objid - from pg_depend - join pkeys on pg_depend.refobjid = pkeys.oid - where classid = 'pg_catalog.pg_constraint'::regclass - and refclassid = 'pg_catalog.pg_class'::regclass -) - select n.nspname, c.relname, nf.nspname, cf.relname as frelname, - r.oid as conoid, conname, - pg_catalog.pg_get_constraintdef(r.oid, true) as condef, - pkdeps.oid as index_oid - from pg_catalog.pg_constraint r - JOIN pkdeps on r.oid = pkdeps.objid - JOIN pg_class c on r.conrelid = c.oid - JOIN pg_namespace n on c.relnamespace = n.oid - JOIN pg_class cf on r.confrelid = cf.oid - JOIN pg_namespace nf on cf.relnamespace = nf.oid - where NOT EXISTS (select 1 from knownfkeys where oid = r.oid)" + (format nil + (sql "/pgsql/list-missing-fk-deps.sql") pkey-oid-list (or fkey-oid-list (list -1)))) ;; @@ -407,14 +315,10 @@ with pkeys(oid) as ( (defun list-table-oids (table-names) "Return an hash table mapping TABLE-NAME to its OID for all table in the TABLE-NAMES list. A PostgreSQL connection must be established already." - (let ((oidmap (make-hash-table :size (length table-names) :test #'equal))) + (let ((oidmap (make-hash-table :size (length table-names) :test #'equal)) + (sql (format nil (sql "/pgsql/list-table-oids.sql") table-names))) (when table-names (loop :for (name oid) - :in (query nil - (format nil - " -select n, n::regclass::oid - from (values ~{('~a')~^,~}) as t(n)" - table-names)) + :in (query nil sql) :do (setf (gethash name oidmap) oid))) oidmap)) diff --git a/src/pgsql/sql/list-all-columns.sql b/src/pgsql/sql/list-all-columns.sql new file mode 100644 index 0000000..ce3b634 --- /dev/null +++ b/src/pgsql/sql/list-all-columns.sql @@ -0,0 +1,23 @@ +-- params: table-type-name +-- including +-- filter-list-to-where-clause for including +-- excluding +-- filter-list-to-where-clause for excluding + select nspname, relname, c.oid, attname, + t.oid::regtype as type, + case when atttypmod > 0 then atttypmod - 4 else null end as typmod, + attnotnull, + case when atthasdef then def.adsrc end as default + from pg_class c + join pg_namespace n on n.oid = c.relnamespace + left join pg_attribute a on c.oid = a.attrelid + join pg_type t on t.oid = a.atttypid and attnum > 0 + left join pg_attrdef def on a.attrelid = def.adrelid + and a.attnum = def.adnum + + where nspname !~~ '^pg_' and n.nspname <> 'information_schema' + and relkind = '~a' + ~:[~*~;and (~{~a~^~&~10t or ~})~] + ~:[~*~;and (~{~a~^~&~10t and ~})~] + + order by nspname, relname, attnum; diff --git a/src/pgsql/sql/list-all-fkeys.sql b/src/pgsql/sql/list-all-fkeys.sql new file mode 100644 index 0000000..cd53ab1 --- /dev/null +++ b/src/pgsql/sql/list-all-fkeys.sql @@ -0,0 +1,36 @@ +-- params: including (table) +-- filter-list-to-where-clause for including +-- excluding (table) +-- filter-list-to-where-clause for excluding +-- including (ftable) +-- filter-list-to-where-clause for including +-- excluding (ftable) +-- filter-list-to-where-clause for excluding + select n.nspname, c.relname, nf.nspname, cf.relname as frelname, + r.oid, conname, + pg_catalog.pg_get_constraintdef(r.oid, true) as condef, + (select string_agg(attname, ',') + from pg_attribute + where attrelid = r.conrelid + and array[attnum::integer] <@ conkey::integer[] + ) as conkey, + (select string_agg(attname, ',') + from pg_attribute + where attrelid = r.confrelid + and array[attnum::integer] <@ confkey::integer[] + ) as confkey, + confupdtype, confdeltype, confmatchtype, + condeferrable, condeferred + from pg_catalog.pg_constraint r + JOIN pg_class c on r.conrelid = c.oid + JOIN pg_namespace n on c.relnamespace = n.oid + JOIN pg_class cf on r.confrelid = cf.oid + JOIN pg_namespace nf on cf.relnamespace = nf.oid + where r.contype = 'f' + AND c.relkind = 'r' and cf.relkind = 'r' + AND n.nspname !~~ '^pg_' and n.nspname <> 'information_schema' + AND nf.nspname !~~ '^pg_' and nf.nspname <> 'information_schema' + ~:[~*~;and (~{~a~^~&~10t or ~})~] + ~:[~*~;and (~{~a~^~&~10t and ~})~] + ~:[~*~;and (~{~a~^~&~10t or ~})~] + ~:[~*~;and (~{~a~^~&~10t and ~})~] diff --git a/src/pgsql/sql/list-all-indexes.sql b/src/pgsql/sql/list-all-indexes.sql new file mode 100644 index 0000000..320a6e0 --- /dev/null +++ b/src/pgsql/sql/list-all-indexes.sql @@ -0,0 +1,27 @@ +-- params: including +-- filter-list-to-where-clause for including +-- excluding +-- filter-list-to-where-clause for excluding + select n.nspname, + i.relname, + i.oid, + rn.nspname, + r.relname, + indisprimary, + indisunique, + pg_get_indexdef(indexrelid), + c.conname, + pg_get_constraintdef(c.oid) + from pg_index x + join pg_class i ON i.oid = x.indexrelid + join pg_class r ON r.oid = x.indrelid + join pg_namespace n ON n.oid = i.relnamespace + join pg_namespace rn ON rn.oid = r.relnamespace + left join pg_constraint c ON c.conindid = i.oid + and c.conrelid = r.oid + -- filter out self-fkeys + and c.confrelid <> r.oid + where n.nspname !~~ '^pg_' and n.nspname <> 'information_schema' + ~:[~*~;and (~{~a~^~&~10t or ~})~] + ~:[~*~;and (~{~a~^~&~10t and ~})~] +order by n.nspname, r.relname diff --git a/src/pgsql/sql/list-missing-fk-deps.sql b/src/pgsql/sql/list-missing-fk-deps.sql new file mode 100644 index 0000000..c815ba1 --- /dev/null +++ b/src/pgsql/sql/list-missing-fk-deps.sql @@ -0,0 +1,26 @@ +-- params pkey-oid-list +-- fkey-oild-list +with pkeys(oid) as ( + values~{(~d)~^,~} +), + knownfkeys(oid) as ( + values~{(~d)~^,~} +), + pkdeps as ( + select pkeys.oid, pg_depend.objid + from pg_depend + join pkeys on pg_depend.refobjid = pkeys.oid + where classid = 'pg_catalog.pg_constraint'::regclass + and refclassid = 'pg_catalog.pg_class'::regclass +) + select n.nspname, c.relname, nf.nspname, cf.relname as frelname, + r.oid as conoid, conname, + pg_catalog.pg_get_constraintdef(r.oid, true) as condef, + pkdeps.oid as index_oid + from pg_catalog.pg_constraint r + JOIN pkdeps on r.oid = pkdeps.objid + JOIN pg_class c on r.conrelid = c.oid + JOIN pg_namespace n on c.relnamespace = n.oid + JOIN pg_class cf on r.confrelid = cf.oid + JOIN pg_namespace nf on cf.relnamespace = nf.oid + where NOT EXISTS (select 1 from knownfkeys where oid = r.oid) diff --git a/src/pgsql/sql/list-table-oids.sql b/src/pgsql/sql/list-table-oids.sql new file mode 100644 index 0000000..f977a46 --- /dev/null +++ b/src/pgsql/sql/list-table-oids.sql @@ -0,0 +1,4 @@ +-- params: table-names +select n, n::regclass::oid + from (values ~{('~a')~^,~}) as t(n); + diff --git a/src/pgsql/sql/list-typenames-without-btree-support.sql b/src/pgsql/sql/list-typenames-without-btree-support.sql new file mode 100644 index 0000000..bd55fe0 --- /dev/null +++ b/src/pgsql/sql/list-typenames-without-btree-support.sql @@ -0,0 +1,15 @@ +select typname, + array_agg(amname order by amname <> 'gist', amname <> 'gin') + from pg_type + join pg_opclass on pg_opclass.opcintype = pg_type.oid + join pg_am on pg_am.oid = pg_opclass.opcmethod + where substring(typname from 1 for 1) <> '_' + and not exists + ( + select amname + from pg_am am + join pg_opclass c on am.oid = c.opcmethod + join pg_type t on c.opcintype = t.oid + where amname = 'btree' and t.oid = pg_type.oid + ) +group by typname; diff --git a/src/pgsql/sql/query-table-schema.sql b/src/pgsql/sql/query-table-schema.sql new file mode 100644 index 0000000..9fd9c83 --- /dev/null +++ b/src/pgsql/sql/query-table-schema.sql @@ -0,0 +1,5 @@ +-- params: table-name + select nspname + from pg_namespace n + join pg_class c on n.oid = c.relnamespace + where c.oid = '~a'::regclass; diff --git a/src/sources/mssql/mssql-schema.lisp b/src/sources/mssql/mssql-schema.lisp index 5ec8b8e..d43fd3f 100644 --- a/src/sources/mssql/mssql-schema.lisp +++ b/src/sources/mssql/mssql-schema.lisp @@ -83,51 +83,8 @@ datetime-precision character-set-name collation-name) :in - (mssql-query (format nil " - select c.table_schema, - c.table_name, - c.column_name, - c.data_type, - CASE - WHEN c.column_default LIKE '((%' AND c.column_default LIKE '%))' THEN - CASE - WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) = 'newid()' THEN 'generate_uuid_v4()' - WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) LIKE 'convert(%varchar%,getdate(),%)' THEN 'today' - WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) = 'getdate()' THEN 'CURRENT_TIMESTAMP' - WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) LIKE '''%''' THEN SUBSTRING(c.column_default,4,len(c.column_default)-6) - ELSE SUBSTRING(c.column_default,3,len(c.column_default)-4) - END - WHEN c.column_default LIKE '(%' AND c.column_default LIKE '%)' THEN - CASE - WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) = 'newid()' THEN 'generate_uuid_v4()' - WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) LIKE 'convert(%varchar%,getdate(),%)' THEN 'today' - WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) = 'getdate()' THEN 'CURRENT_TIMESTAMP' - WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) LIKE '''%''' THEN SUBSTRING(c.column_default,3,len(c.column_default)-4) - ELSE SUBSTRING(c.column_default,2,len(c.column_default)-2) - END - ELSE c.column_default - END, - c.is_nullable, - COLUMNPROPERTY(object_id(c.table_name), c.column_name, 'IsIdentity'), - c.CHARACTER_MAXIMUM_LENGTH, - c.NUMERIC_PRECISION, - c.NUMERIC_PRECISION_RADIX, - c.NUMERIC_SCALE, - c.DATETIME_PRECISION, - c.CHARACTER_SET_NAME, - c.COLLATION_NAME - - from information_schema.columns c - join information_schema.tables t - on c.table_schema = t.table_schema - and c.table_name = t.table_name - - where c.table_catalog = '~a' - and t.table_type = '~a' - ~:[~*~;and (~{~a~^~&~10t or ~})~] - ~:[~*~;and (~{~a~^~&~10t and ~})~] - -order by c.table_schema, c.table_name, c.ordinal_position" + (mssql-query (format nil + (sql "/mssql/list-all-columns.sql") (db-name *mssql-db*) table-type-name including ; do we print the clause? @@ -158,31 +115,8 @@ order by c.table_schema, c.table_name, c.ordinal_position" "Get the list of MSSQL index definitions per table." (loop :for (schema-name table-name index-name colname unique pkey filter) - :in (mssql-query (format nil " - select schema_name(schema_id) as SchemaName, - o.name as TableName, - REPLACE(i.name, '.', '_') as IndexName, - co.[name] as ColumnName, - i.is_unique, - i.is_primary_key, - i.filter_definition - - from sys.indexes i - join sys.objects o on i.object_id = o.object_id - join sys.index_columns ic on ic.object_id = i.object_id - and ic.index_id = i.index_id - join sys.columns co on co.object_id = i.object_id - 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" + :in (mssql-query (format nil + (sql "/mssql/list-all-indexes.sql") including ; do we print the clause? (filter-list-to-where-clause including nil @@ -213,40 +147,11 @@ order by SchemaName, (defun list-all-fkeys (catalog &key including excluding) "Get the list of MSSQL index definitions per table." (loop - :for (fkey-name schema-name table-name col fschema-name ftable-name fcol fk-update-rule fk-delete-rule) - :in (mssql-query (format nil " - SELECT - REPLACE(KCU1.CONSTRAINT_NAME, '.', '_') AS 'CONSTRAINT_NAME' - , KCU1.TABLE_SCHEMA AS 'TABLE_SCHEMA' - , KCU1.TABLE_NAME AS 'TABLE_NAME' - , KCU1.COLUMN_NAME AS 'COLUMN_NAME' - , KCU2.TABLE_SCHEMA AS 'UNIQUE_TABLE_SCHEMA' - , KCU2.TABLE_NAME AS 'UNIQUE_TABLE_NAME' - , KCU2.COLUMN_NAME AS 'UNIQUE_COLUMN_NAME' - , RC.UPDATE_RULE AS 'UPDATE_RULE' - , RC.DELETE_RULE AS 'DELETE_RULE' - - FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS RC - JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU1 - ON KCU1.CONSTRAINT_CATALOG = RC.CONSTRAINT_CATALOG - AND KCU1.CONSTRAINT_SCHEMA = RC.CONSTRAINT_SCHEMA - AND KCU1.CONSTRAINT_NAME = RC.CONSTRAINT_NAME - JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU2 - ON KCU2.CONSTRAINT_CATALOG = RC.UNIQUE_CONSTRAINT_CATALOG - AND KCU2.CONSTRAINT_SCHEMA = RC.UNIQUE_CONSTRAINT_SCHEMA - AND KCU2.CONSTRAINT_NAME = RC.UNIQUE_CONSTRAINT_NAME - - WHERE KCU1.ORDINAL_POSITION = KCU2.ORDINAL_POSITION - AND KCU1.TABLE_CATALOG = '~a' - AND KCU1.CONSTRAINT_CATALOG = '~a' - AND KCU1.CONSTRAINT_SCHEMA NOT IN ('dto', 'sys') - AND KCU1.TABLE_SCHEMA NOT IN ('dto', 'sys') - AND KCU2.TABLE_SCHEMA NOT IN ('dto', 'sys') - - ~:[~*~;and (~{~a~^ or ~})~] - ~:[~*~;and (~{~a~^ and ~})~] - -ORDER BY KCU1.CONSTRAINT_NAME, KCU1.ORDINAL_POSITION" + :for (fkey-name schema-name table-name col + fschema-name ftable-name fcol + fk-update-rule fk-delete-rule) + :in (mssql-query (format nil + (sql "/mssql/list-all-fkeys.sql") (db-name *mssql-db*) (db-name *mssql-db*) including ; do we print the clause? (filter-list-to-where-clause including diff --git a/src/sources/mssql/sql/list-all-columns.sql b/src/sources/mssql/sql/list-all-columns.sql new file mode 100644 index 0000000..057e9c2 --- /dev/null +++ b/src/sources/mssql/sql/list-all-columns.sql @@ -0,0 +1,50 @@ +-- params: dbname +-- table-type-name +-- including +-- filter-list-to-where-clause including +-- excluding +-- filter-list-to-where-clause excluding + select c.table_schema, + c.table_name, + c.column_name, + c.data_type, + CASE + WHEN c.column_default LIKE '((%' AND c.column_default LIKE '%))' THEN + CASE + WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) = 'newid()' THEN 'generate_uuid_v4()' + WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) LIKE 'convert(%varchar%,getdate(),%)' THEN 'today' + WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) = 'getdate()' THEN 'CURRENT_TIMESTAMP' + WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) LIKE '''%''' THEN SUBSTRING(c.column_default,4,len(c.column_default)-6) + ELSE SUBSTRING(c.column_default,3,len(c.column_default)-4) + END + WHEN c.column_default LIKE '(%' AND c.column_default LIKE '%)' THEN + CASE + WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) = 'newid()' THEN 'generate_uuid_v4()' + WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) LIKE 'convert(%varchar%,getdate(),%)' THEN 'today' + WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) = 'getdate()' THEN 'CURRENT_TIMESTAMP' + WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) LIKE '''%''' THEN SUBSTRING(c.column_default,3,len(c.column_default)-4) + ELSE SUBSTRING(c.column_default,2,len(c.column_default)-2) + END + ELSE c.column_default + END, + c.is_nullable, + COLUMNPROPERTY(object_id(c.table_name), c.column_name, 'IsIdentity'), + c.CHARACTER_MAXIMUM_LENGTH, + c.NUMERIC_PRECISION, + c.NUMERIC_PRECISION_RADIX, + c.NUMERIC_SCALE, + c.DATETIME_PRECISION, + c.CHARACTER_SET_NAME, + c.COLLATION_NAME + + from information_schema.columns c + join information_schema.tables t + on c.table_schema = t.table_schema + and c.table_name = t.table_name + + where c.table_catalog = '~a' + and t.table_type = '~a' + ~:[~*~;and (~{~a~^~&~10t or ~})~] + ~:[~*~;and (~{~a~^~&~10t and ~})~] + +order by c.table_schema, c.table_name, c.ordinal_position; diff --git a/src/sources/mssql/sql/list-all-fkeys.sql b/src/sources/mssql/sql/list-all-fkeys.sql new file mode 100644 index 0000000..89e74ca --- /dev/null +++ b/src/sources/mssql/sql/list-all-fkeys.sql @@ -0,0 +1,37 @@ +-- params: dbname +-- including +-- filter-list-to-where-clause including +-- excluding +-- filter-list-to-where-clause excluding + SELECT + REPLACE(KCU1.CONSTRAINT_NAME, '.', '_') AS 'CONSTRAINT_NAME' + , KCU1.TABLE_SCHEMA AS 'TABLE_SCHEMA' + , KCU1.TABLE_NAME AS 'TABLE_NAME' + , KCU1.COLUMN_NAME AS 'COLUMN_NAME' + , KCU2.TABLE_SCHEMA AS 'UNIQUE_TABLE_SCHEMA' + , KCU2.TABLE_NAME AS 'UNIQUE_TABLE_NAME' + , KCU2.COLUMN_NAME AS 'UNIQUE_COLUMN_NAME' + , RC.UPDATE_RULE AS 'UPDATE_RULE' + , RC.DELETE_RULE AS 'DELETE_RULE' + + FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS RC + JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU1 + ON KCU1.CONSTRAINT_CATALOG = RC.CONSTRAINT_CATALOG + AND KCU1.CONSTRAINT_SCHEMA = RC.CONSTRAINT_SCHEMA + AND KCU1.CONSTRAINT_NAME = RC.CONSTRAINT_NAME + JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU2 + ON KCU2.CONSTRAINT_CATALOG = RC.UNIQUE_CONSTRAINT_CATALOG + AND KCU2.CONSTRAINT_SCHEMA = RC.UNIQUE_CONSTRAINT_SCHEMA + AND KCU2.CONSTRAINT_NAME = RC.UNIQUE_CONSTRAINT_NAME + + WHERE KCU1.ORDINAL_POSITION = KCU2.ORDINAL_POSITION + AND KCU1.TABLE_CATALOG = '~a' + AND KCU1.CONSTRAINT_CATALOG = '~a' + AND KCU1.CONSTRAINT_SCHEMA NOT IN ('dto', 'sys') + AND KCU1.TABLE_SCHEMA NOT IN ('dto', 'sys') + AND KCU2.TABLE_SCHEMA NOT IN ('dto', 'sys') + + ~:[~*~;and (~{~a~^ or ~})~] + ~:[~*~;and (~{~a~^ and ~})~] + +ORDER BY KCU1.CONSTRAINT_NAME, KCU1.ORDINAL_POSITION; diff --git a/src/sources/mssql/sql/list-all-indexes.sql b/src/sources/mssql/sql/list-all-indexes.sql new file mode 100644 index 0000000..4278032 --- /dev/null +++ b/src/sources/mssql/sql/list-all-indexes.sql @@ -0,0 +1,28 @@ +-- params: including +-- filter-list-to-where-clause including +-- excluding +-- filter-list-to-where-clause excluding + select schema_name(schema_id) as SchemaName, + o.name as TableName, + REPLACE(i.name, '.', '_') as IndexName, + co.[name] as ColumnName, + i.is_unique, + i.is_primary_key, + i.filter_definition + + from sys.indexes i + join sys.objects o on i.object_id = o.object_id + join sys.index_columns ic on ic.object_id = i.object_id + and ic.index_id = i.index_id + join sys.columns co on co.object_id = i.object_id + 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; diff --git a/src/sources/mysql/mysql-schema.lisp b/src/sources/mysql/mysql-schema.lisp index bb0468d..a111832 100644 --- a/src/sources/mysql/mysql-schema.lisp +++ b/src/sources/mysql/mysql-schema.lisp @@ -181,18 +181,8 @@ (loop :for (tname tcomment cname ccomment dtype ctype default nullable extra) :in - (mysql-query (format nil " - select c.table_name, t.table_comment, - c.column_name, c.column_comment, - c.data_type, c.column_type, c.column_default, - c.is_nullable, c.extra - from information_schema.columns c - join information_schema.tables t using(table_schema, table_name) - where c.table_schema = '~a' and t.table_type = '~a' - ~:[~*~;and table_name in (~{'~a'~^,~})~] - ~:[~*~;and (~{table_name ~a~^ or ~})~] - ~:[~*~;and (~{table_name ~a~^ and ~})~] -order by table_name, ordinal_position" + (mysql-query (format nil + (sql "/mysql/list-all-columns.sql") (db-name *connection*) table-type-name only-tables ; do we print the clause? @@ -224,15 +214,8 @@ order by table_name, ordinal_position" "Get the list of MySQL index definitions per table." (loop :for (table-name name non-unique cols) - :in (mysql-query (format nil " - SELECT table_name, index_name, sum(non_unique), - cast(GROUP_CONCAT(column_name order by seq_in_index) as char) - FROM information_schema.statistics - WHERE table_schema = '~a' - ~:[~*~;and table_name in (~{'~a'~^,~})~] - ~:[~*~;and (~{table_name ~a~^ or ~})~] - ~:[~*~;and (~{table_name ~a~^ and ~})~] -GROUP BY table_name, index_name;" + :in (mysql-query (format nil + (sql "/mysql/list-all-indexes.sql") (db-name *connection*) only-tables ; do we print the clause? only-tables @@ -265,41 +248,8 @@ GROUP BY table_name, index_name;" "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 (format nil " -SELECT s.table_name, s.constraint_name, s.ft, s.cols, s.fcols, - rc.update_rule, rc.delete_rule - -FROM - ( - SELECT tc.table_schema, tc.table_name, - tc.constraint_name, k.referenced_table_name ft, - - group_concat( k.column_name - order by k.ordinal_position) as cols, - - group_concat( k.referenced_column_name - order by k.position_in_unique_constraint) as fcols - - FROM information_schema.table_constraints tc - - LEFT JOIN information_schema.key_column_usage k - ON k.table_schema = tc.table_schema - AND k.table_name = tc.table_name - AND k.constraint_name = tc.constraint_name - - WHERE tc.table_schema = '~a' - AND k.referenced_table_schema = '~a' - AND tc.constraint_type = 'FOREIGN KEY' - ~:[~*~;and tc.table_name in (~{'~a'~^,~})~] - ~:[~*~;and (~{tc.table_name ~a~^ or ~})~] - ~:[~*~;and (~{tc.table_name ~a~^ and ~})~] - - GROUP BY tc.table_schema, tc.table_name, tc.constraint_name, ft - ) s - JOIN information_schema.referential_constraints rc - ON rc.constraint_schema = s.table_schema - AND rc.constraint_name = s.constraint_name - AND rc.table_name = s.table_name" + :in (mysql-query (format nil + (sql "/mysql/list-all-fkeys.sql") (db-name *connection*) (db-name *connection*) only-tables ; do we print the clause? only-tables @@ -347,14 +297,8 @@ FROM "Return comments on MySQL tables." (loop :for (table-name comment) - :in (mysql-query (format nil " - SELECT table_name, table_comment - FROM information_schema.tables - WHERE table_schema = '~a' - and table_type = 'BASE TABLE' - ~:[~*~;and table_name in (~{'~a'~^,~})~] - ~:[~*~;and (~{table_name ~a~^ or ~})~] - ~:[~*~;and (~{table_name ~a~^ and ~})~]" + :in (mysql-query (format nil + (sql "/mysql/list-table-comments.sql") (db-name *connection*) only-tables ; do we print the clause? only-tables @@ -372,16 +316,8 @@ FROM "Return comments on MySQL tables." (loop :for (table-name column-name comment) - :in (mysql-query (format nil " - select c.table_name, c.column_name, c.column_comment - from information_schema.columns c - join information_schema.tables t using(table_schema, table_name) - where c.table_schema = '~a' - and t.table_type = 'BASE TABLE' - ~:[~*~;and table_name in (~{'~a'~^,~})~] - ~:[~*~;and (~{table_name ~a~^ or ~})~] - ~:[~*~;and (~{table_name ~a~^ and ~})~] -order by table_name, ordinal_position" + :in (mysql-query (format nil + (sql "/mysql/list-columns-comments.sql") (db-name *connection*) only-tables ; do we print the clause? only-tables @@ -413,13 +349,10 @@ order by table_name, ordinal_position" This function assumes a valid connection to the MySQL server has been established already." - (loop - for (name type) in (mysql-query (format nil " - select column_name, data_type - from information_schema.columns - where table_schema = '~a' and table_name = '~a' -order by ordinal_position" dbname table-name) - :result-type 'list) + (loop with sql = (format nil + (sql "/mysql/get-column-list.sql") + dbname table-name) + for (name type) in (mysql-query sql :result-type 'list) collect (get-column-sql-expression name type))) (declaim (inline fix-nulls)) diff --git a/src/sources/mysql/sql/get-column-list.sql b/src/sources/mysql/sql/get-column-list.sql new file mode 100644 index 0000000..8de5952 --- /dev/null +++ b/src/sources/mysql/sql/get-column-list.sql @@ -0,0 +1,6 @@ +-- params: dbname +-- table-name + select column_name, data_type + from information_schema.columns + where table_schema = '~a' and table_name = '~a' +order by ordinal_position; diff --git a/src/sources/mysql/sql/list-all-columns.sql b/src/sources/mysql/sql/list-all-columns.sql new file mode 100644 index 0000000..8932a46 --- /dev/null +++ b/src/sources/mysql/sql/list-all-columns.sql @@ -0,0 +1,19 @@ +-- params: db-name +-- table-type-name +-- only-tables +-- only-tables +-- including +-- filter-list-to-where-clause incuding +-- excluding +-- filter-list-to-where-clause excluding + select c.table_name, t.table_comment, + c.column_name, c.column_comment, + c.data_type, c.column_type, c.column_default, + c.is_nullable, c.extra + from information_schema.columns c + join information_schema.tables t using(table_schema, table_name) + where c.table_schema = '~a' and t.table_type = '~a' + ~:[~*~;and table_name in (~{'~a'~^,~})~] + ~:[~*~;and (~{table_name ~a~^ or ~})~] + ~:[~*~;and (~{table_name ~a~^ and ~})~] +order by table_name, ordinal_position; diff --git a/src/sources/mysql/sql/list-all-fkeys.sql b/src/sources/mysql/sql/list-all-fkeys.sql new file mode 100644 index 0000000..6b7aeb5 --- /dev/null +++ b/src/sources/mysql/sql/list-all-fkeys.sql @@ -0,0 +1,42 @@ +-- params: db-name +-- table-type-name +-- only-tables +-- only-tables +-- including +-- filter-list-to-where-clause incuding +-- excluding +-- filter-list-to-where-clause excluding +SELECT s.table_name, s.constraint_name, s.ft, s.cols, s.fcols, + rc.update_rule, rc.delete_rule + +FROM + ( + SELECT tc.table_schema, tc.table_name, + tc.constraint_name, k.referenced_table_name ft, + + group_concat( k.column_name + order by k.ordinal_position) as cols, + + group_concat( k.referenced_column_name + order by k.position_in_unique_constraint) as fcols + + FROM information_schema.table_constraints tc + + LEFT JOIN information_schema.key_column_usage k + ON k.table_schema = tc.table_schema + AND k.table_name = tc.table_name + AND k.constraint_name = tc.constraint_name + + WHERE tc.table_schema = '~a' + AND k.referenced_table_schema = '~a' + AND tc.constraint_type = 'FOREIGN KEY' + ~:[~*~;and tc.table_name in (~{'~a'~^,~})~] + ~:[~*~;and (~{tc.table_name ~a~^ or ~})~] + ~:[~*~;and (~{tc.table_name ~a~^ and ~})~] + + GROUP BY tc.table_schema, tc.table_name, tc.constraint_name, ft + ) s + JOIN information_schema.referential_constraints rc + ON rc.constraint_schema = s.table_schema + AND rc.constraint_name = s.constraint_name + AND rc.table_name = s.table_name; diff --git a/src/sources/mysql/sql/list-all-indexes.sql b/src/sources/mysql/sql/list-all-indexes.sql new file mode 100644 index 0000000..2d3fd32 --- /dev/null +++ b/src/sources/mysql/sql/list-all-indexes.sql @@ -0,0 +1,16 @@ +-- params: db-name +-- table-type-name +-- only-tables +-- only-tables +-- including +-- filter-list-to-where-clause incuding +-- excluding +-- filter-list-to-where-clause excluding + SELECT table_name, index_name, sum(non_unique), + cast(GROUP_CONCAT(column_name order by seq_in_index) as char) + FROM information_schema.statistics + WHERE table_schema = '~a' + ~:[~*~;and table_name in (~{'~a'~^,~})~] + ~:[~*~;and (~{table_name ~a~^ or ~})~] + ~:[~*~;and (~{table_name ~a~^ and ~})~] +GROUP BY table_name, index_name; diff --git a/src/sources/mysql/sql/list-columns-comments.sql b/src/sources/mysql/sql/list-columns-comments.sql new file mode 100644 index 0000000..96bae14 --- /dev/null +++ b/src/sources/mysql/sql/list-columns-comments.sql @@ -0,0 +1,17 @@ +-- params: db-name +-- table-type-name +-- only-tables +-- only-tables +-- including +-- filter-list-to-where-clause incuding +-- excluding +-- filter-list-to-where-clause excluding + select c.table_name, c.column_name, c.column_comment + from information_schema.columns c + join information_schema.tables t using(table_schema, table_name) + where c.table_schema = '~a' + and t.table_type = 'BASE TABLE' + ~:[~*~;and table_name in (~{'~a'~^,~})~] + ~:[~*~;and (~{table_name ~a~^ or ~})~] + ~:[~*~;and (~{table_name ~a~^ and ~})~] +order by table_name, ordinal_position; diff --git a/src/sources/mysql/sql/list-table-comments.sql b/src/sources/mysql/sql/list-table-comments.sql new file mode 100644 index 0000000..6fab059 --- /dev/null +++ b/src/sources/mysql/sql/list-table-comments.sql @@ -0,0 +1,15 @@ +-- params: db-name +-- table-type-name +-- only-tables +-- only-tables +-- including +-- filter-list-to-where-clause incuding +-- excluding +-- filter-list-to-where-clause excluding + SELECT table_name, table_comment + FROM information_schema.tables + WHERE table_schema = '~a' + and table_type = 'BASE TABLE' + ~:[~*~;and table_name in (~{'~a'~^,~})~] + ~:[~*~;and (~{table_name ~a~^ or ~})~] + ~:[~*~;and (~{table_name ~a~^ and ~})~]; diff --git a/src/utils/queries.lisp b/src/utils/queries.lisp new file mode 100644 index 0000000..b0364d1 --- /dev/null +++ b/src/utils/queries.lisp @@ -0,0 +1,68 @@ +;;; +;;; Load SQL queries at load-time into an hash table and offer a function to +;;; get the SQL query text from the source code. This allows to maintain +;;; proper .sql files in the source code, for easier maintenance. +;;; + +(in-package :pgloader.queries) + +(defparameter *src* + (uiop:pathname-directory-pathname + (asdf:system-relative-pathname :pgloader "src/")) + "Source directory where to look for .sql query files.") + +(defun load-static-file (fs pathname url) + "Load given PATHNAME contents at URL-PATH in FS." + (setf (gethash url fs) + (alexandria:read-file-into-string pathname))) + +(defun pathname-to-url (pathname &optional (root *src*)) + "Transform given PATHNAME into an URL at which to serve it within URL-PATH." + (multiple-value-bind (flag path-list last-component file-namestring-p) + (uiop:split-unix-namestring-directory-components + (uiop:native-namestring + (uiop:enough-pathname pathname root))) + (declare (ignore flag file-namestring-p)) + ;; + ;; we store SQL queries in a sql/ subdirectory because it's easier to + ;; manage the code that way, but it's an implementation detail that we + ;; are hiding in the query url abstraction... + ;; + ;; then do the same thing with the "sources" in /src/sources/.../sql/... + ;; + (let ((no-sql-path-list + (remove-if (lambda (path) + (member path (list "sources" "sql") + :test #'string=)) + path-list))) + (format nil "~{/~a~}/~a" no-sql-path-list last-component)))) + +(defun load-static-directory (fs &optional (root *src*)) + "Walk PATH and load all files found in there as binary sequence, FS being + an hash table referencing the full path against the bytes." + (flet ((collectp (dir) (declare (ignore dir)) t) + (recursep (dir) (declare (ignore dir)) t) + (collector (dir) + (loop :for pathname :in (uiop:directory-files dir) + :do (when (string= "sql" (pathname-type pathname)) + (let ((url (pathname-to-url pathname root))) + (load-static-file fs pathname url)))))) + (uiop:collect-sub*directories root #'collectp #'recursep #'collector))) + +(defun walk-sources-and-build-fs () + (let ((fs (make-hash-table :test #'equal))) + (load-static-directory fs) + fs)) + +(defparameter *fs* + (walk-sources-and-build-fs) + "File system as an hash-table in memory.") + +(defun sql (url) + "Abstract the hash-table based implementation of our SQL file system." + (restart-case + (or (gethash url *fs*) + (error "URL ~s not found!" url)) + (recompute-fs-and-retry () + (setf *fs* (walk-sources-and-build-fs)) + (sql url))))