From 344d0ca61b3f34b565cf60f719a33f4f99f01254 Mon Sep 17 00:00:00 2001 From: Dimitri Fontaine Date: Wed, 10 Oct 2018 11:08:28 -0700 Subject: [PATCH] Implement AFTER SCHEMA sql code blocks. This allows pgloader users to run SQL commands in between pgloader's schema creation and the actual loading of the data. --- src/load/migrate-database.lisp | 32 ++++++++++++++++++++---------- src/package.lisp | 1 + src/parsers/command-pgsql.lisp | 9 ++++++--- src/parsers/command-sql-block.lisp | 31 +++++++++++++++++++---------- 4 files changed, 48 insertions(+), 25 deletions(-) diff --git a/src/load/migrate-database.lisp b/src/load/migrate-database.lisp index 044d931..28f57c9 100644 --- a/src/load/migrate-database.lisp +++ b/src/load/migrate-database.lisp @@ -255,6 +255,7 @@ (reset-sequences t) (foreign-keys t) (reindex nil) + (after-schema nil) only-tables including excluding @@ -329,17 +330,26 @@ ;; if asked, first drop/create the tables on the PostgreSQL side (handler-case - (prepare-pgsql-database copy - catalog - :truncate truncate - :create-tables create-tables - :create-schemas create-schemas - :drop-indexes drop-indexes - :drop-schema drop-schema - :include-drop include-drop - :foreign-keys foreign-keys - :set-table-oids set-table-oids - :materialize-views materialize-views) + (progn + (prepare-pgsql-database copy + catalog + :truncate truncate + :create-tables create-tables + :create-schemas create-schemas + :drop-indexes drop-indexes + :drop-schema drop-schema + :include-drop include-drop + :foreign-keys foreign-keys + :set-table-oids set-table-oids + :materialize-views materialize-views) + + ;; if there's an AFTER SCHEMA DO/EXECUTE command, now is the time + ;; to run it. + (when after-schema + (pgloader.parser::execute-sql-code-block (target-db copy) + :pre + after-schema + "after schema"))) ;; ;; In case some error happens in the preparatory transaction, we ;; need to stop now and refrain from trying to load the data into diff --git a/src/package.lisp b/src/package.lisp index 8e81cdf..bc9abfe 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -812,6 +812,7 @@ (:export #:parse-commands #:parse-commands-from-file #:initialize-context + #:execute-sql-code-block ;; tools to enable complete cli parsing in main.lisp #:process-relative-pathnames diff --git a/src/parsers/command-pgsql.lisp b/src/parsers/command-pgsql.lisp index 3650534..6599c4f 100644 --- a/src/parsers/command-pgsql.lisp +++ b/src/parsers/command-pgsql.lisp @@ -79,6 +79,7 @@ excluding-matching-in-schema decoding-tables-as before-load + after-schema after-load)) (:lambda (clauses-list) (alexandria:alist-plist clauses-list))) @@ -103,11 +104,11 @@ (defun lisp-code-for-loading-from-pgsql (pg-src-db-conn pg-dst-db-conn &key gucs - casts before after options + casts options + before after after-schema alter-table alter-schema ((:including incl)) ((:excluding excl)) - ((:decoding decoding-as)) &allow-other-keys) `(lambda () (let* ((*default-cast-rules* ',*pgsql-default-cast-rules*) @@ -131,6 +132,7 @@ :index-names :preserve :set-table-oids t :on-error-stop on-error-stop + :after-schema ',after-schema ,@(remove-batch-control-option options)) ,(sql-code-block pg-dst-db-conn :post after "after load")))) @@ -140,7 +142,7 @@ (destructuring-bind (pg-src-db-uri pg-dst-db-uri &key - gucs casts before after options + gucs casts before after after-schema options alter-table alter-schema including excluding decoding) source @@ -152,6 +154,7 @@ :casts casts :before before :after after + :after-schema after-schema :options options :alter-table alter-table :alter-schema alter-schema diff --git a/src/parsers/command-sql-block.lisp b/src/parsers/command-sql-block.lisp index dba0a4b..e99bd07 100644 --- a/src/parsers/command-sql-block.lisp +++ b/src/parsers/command-sql-block.lisp @@ -58,17 +58,26 @@ (bind (((_ _ sql-list-of-list) after)) (cons :after (apply #'append sql-list-of-list))))) +(defrule after-schema (and kw-after kw-create kw-schema + (+ (or load-do load-execute))) + (:lambda (after) + (bind (((_ _ _ sql-list-of-list) after)) + (cons :after-schema (apply #'append sql-list-of-list))))) + (defun sql-code-block (pgconn section commands label) "Return lisp code to run COMMANDS against DBNAME, updating STATE." (when commands - `(with-stats-collection (,label - :dbname ,(db-name pgconn) - :section ,section - :use-result-as-read t - :use-result-as-rows t) - (log-message :notice "Executing SQL block for ~a" ,label) - (with-pgsql-transaction (:pgconn ,pgconn) - (loop for command in ',commands - do - (pgsql-execute command :client-min-messages :error) - counting command))))) + `(execute-sql-code-block ,pgconn ,section ',commands ,label))) + +(defun execute-sql-code-block (pgconn section commands label) + "Exceute given SQL commands." + (with-stats-collection (label + :dbname (db-name pgconn) + :section section + :use-result-as-read t + :use-result-as-rows t) + (log-message :notice "Executing SQL block for ~a" label) + (with-pgsql-transaction (:pgconn pgconn) + (loop :for command :in commands + :do (pgsql-execute command :client-min-messages :error) + :counting command))))