Implement materialize views in PostgreSQL source support.

pgloader.asd

@@ -180,6 +180,7 @@
                                 :serial t
                                 :depends-on ("common")
                                 :components ((:file "pgsql-cast-rules")
+                                             (:file "pgsql-schema")
                                              (:file "pgsql")))))
 
              ;; package pgloader.copy

src/package.lisp

@@ -452,6 +452,9 @@
 
            #:create-distributed-table
 
+           #:make-including-expr-from-catalog
+           #:make-including-expr-from-view-names
+
            ;; finalizing catalogs support (redshift and other variants)
            #:finalize-catalogs
            #:adjust-data-types

src/parsers/command-materialize-views.lisp

@@ -6,11 +6,8 @@
 ;;;
 (in-package #:pgloader.parser)
 
-(defrule view-name (and (alpha-char-p character)
-			(* (or (alpha-char-p character)
-			       (digit-char-p character)
-			       #\_)))
-  (:text t))
+(defrule view-name (or qualified-table-name maybe-quoted-namestring)
+  (:identity t))
 
 (defrule view-sql (and kw-as dollar-quoted)
   (:destructure (as sql) (declare (ignore as)) sql))
@@ -18,7 +15,7 @@
 (defrule view-definition (and view-name (? view-sql))
   (:destructure (name sql) (cons name sql)))
 
-(defrule another-view-definition (and comma view-definition)
+(defrule another-view-definition (and comma-separator view-definition)
   (:lambda (source)
     (bind (((_ view) source)) view)))
 

src/parsers/command-pgsql.lisp

@@ -110,6 +110,7 @@
                                            alter-table alter-schema
                                            ((:including incl))
                                            ((:excluding excl))
+                                           views
                                            distribute
                                            &allow-other-keys)
   `(lambda ()
@@ -129,6 +130,7 @@
        (copy-database source
                       :including ',incl
                       :excluding ',excl
+                      :materialize-views ',views
                       :alter-table ',alter-table
                       :alter-schema ',alter-schema
                       :index-names :preserve
@@ -146,7 +148,7 @@
                          pg-dst-db-uri
                          &key
                          gucs casts before after after-schema options
-                         alter-table alter-schema distribute
+                         alter-table alter-schema views distribute
                          including excluding decoding)
         source
       (cond (*dry-run*
@@ -155,6 +157,7 @@
              (lisp-code-for-loading-from-pgsql pg-src-db-uri pg-dst-db-uri
                                                :gucs gucs
                                                :casts casts
+                                               :views views
                                                :before before
                                                :after after
                                                :after-schema after-schema

src/parsers/command-utils.lisp

@@ -30,7 +30,7 @@
 (defrule ignore-whitespace (* whitespace)
   (:constant nil))
 
-(defrule punct (or #\, #\- #\_ #\$ #\%)
+(defrule punct (or #\- #\_ #\$ #\%)
   (:text t))
 
 (defrule namestring (and (or #\_ (alpha-char-p character))

src/pgsql/pgsql-schema.lisp

@@ -119,6 +119,27 @@
                                    (table-name table))
                            :single)))
 
+(defun make-including-expr-from-view-names (view-names)
+  "Turn MATERIALIZING VIEWs list of view names into an INCLUDING parameter."
+  (let (including current-schema)
+    (loop :for (schema-name . view-name) :in view-names
+       :do (let* ((schema-name
+                   (if schema-name
+                       (ensure-unquoted schema-name)
+                       (or
+                        current-schema
+                        (setf current-schema
+                              (pomo:query "select current_schema()" :single)))))
+                  (table-expr
+                   (make-string-match-rule :target (ensure-unquoted view-name)))
+                  (schema-entry
+                   (or (assoc schema-name including :test #'string=)
+                       (progn (push (cons schema-name nil) including)
+                              (assoc schema-name including :test #'string=)))))
+             (push-to-end table-expr (cdr schema-entry))))
+    ;; return the including alist
+    including))
+
 
 (defvar *table-type*
   '((:table    . ("r" "f" "p"))   ; ordinary, foreign and partitioned

src/sources/pgsql/pgsql-schema.lisp

@@ -0,0 +1,50 @@
+(in-package :pgloader.source.pgsql)
+
+(defun create-pg-views (views-alist)
+  "VIEWS-ALIST associates view names with their SQL definition, which might
+   be empty for already existing views. Create only the views for which we
+   have an SQL definition."
+  (unless (eq :all views-alist)
+    (let ((views (remove-if #'null views-alist :key #'cdr)))
+      (when views
+        (loop :for (name . def) :in views
+           :for sql := (destructuring-bind (schema . v-name) name
+                         (format nil
+                                 "CREATE VIEW ~s.~s AS ~a"
+                                 schema v-name def))
+           :do (progn
+                 (log-message :info "PostgreSQL Source: ~a" sql)
+                 #+pgloader-image
+                 (pgsql-execute sql)
+                 #-pgloader-image
+                 (restart-case
+                     (pgsql-execute sql)
+                   (use-existing-view ()
+                     :report "Use the already existing view and continue"
+                     nil)
+                   (replace-view ()
+                     :report
+                     "Replace the view with the one from pgloader's command"
+                     (let ((drop-sql (format nil "DROP VIEW ~a;" (car name))))
+                       (log-message :info "PostgreSQL Source: ~a" drop-sql)
+                       (pgsql-execute drop-sql)
+                       (pgsql-execute sql))))))))))
+
+(defun drop-pg-views (views-alist)
+  "See `create-pg-views' for VIEWS-ALIST description. This time we DROP the
+   views to clean out after our work."
+  (unless (eq :all views-alist)
+   (let ((views (remove-if #'null views-alist :key #'cdr)))
+     (when views
+       (let ((sql
+              (with-output-to-string (sql)
+                (format sql "DROP VIEW ")
+                (loop :for view-definition :in views
+                   :for i :from 0
+                   :do (destructuring-bind (name . def) view-definition
+                         (declare (ignore def))
+                         (format sql
+                                 "~@[, ~]~s.~s"
+                                 (not (zerop i)) (car name) (cdr name)))))))
+         (log-message :info "PostgreSQL Source: ~a" sql)
+         (pgsql-execute sql))))))

src/sources/pgsql/pgsql.lisp

@@ -76,7 +76,7 @@
                              including
                              excluding)
   "PostgreSQL introspection to prepare the migration."
-  (declare (ignore materialize-views only-tables))
+  (declare (ignore only-tables))
   (with-stats-collection ("fetch meta data"
                           :use-result-as-rows t
                           :use-result-as-read t
@@ -84,29 +84,59 @@
     (with-pgsql-transaction (:pgconn (source-db pgsql))
       (let ((variant   (pgconn-variant (source-db pgsql)))
             (pgversion (pgconn-major-version (source-db pgsql))))
-       (when (eq :pgdg variant)
-         (list-all-sqltypes catalog
+        ;;
+        ;; First, create the source views that we're going to materialize in
+        ;; the target database.
+        ;;
+        (when (and materialize-views (not (eq :all materialize-views)))
+          (create-pg-views materialize-views))
+
+        (when (eq :pgdg variant)
+          (list-all-sqltypes catalog
+                             :including including
+                             :excluding excluding))
+
+        (list-all-columns catalog
+                          :including including
+                          :excluding excluding)
+
+        (let* ((view-names (unless (eq :all materialize-views)
+                             (mapcar #'car materialize-views)))
+               (including  (make-including-expr-from-view-names view-names)))
+          (cond (view-names
+                 (list-all-columns catalog
+                                   :including including
+                                   :table-type :view))
+
+                ((eq :all materialize-views)
+                 (list-all-columns catalog :table-type :view))))
+
+        (when create-indexes
+          (list-all-indexes catalog
                             :including including
-                            :excluding excluding))
+                            :excluding excluding
+                            :pgversion pgversion))
 
-       (list-all-columns catalog
-                         :including including
-                         :excluding excluding)
+        (when (and (eq :pgdg variant) foreign-keys)
+          (list-all-fkeys catalog
+                          :including including
+                          :excluding excluding))
 
-       (when create-indexes
-         (list-all-indexes catalog
-                           :including including
-                           :excluding excluding
-                           :pgversion pgversion))
-
-       (when (and (eq :pgdg variant) foreign-keys)
-         (list-all-fkeys catalog
-                         :including including
-                         :excluding excluding))
-
-       ;; return how many objects we're going to deal with in total
-       ;; for stats collection
-       (+ (count-tables catalog) (count-indexes catalog)))))
+        ;; return how many objects we're going to deal with in total
+        ;; for stats collection
+        (+ (count-tables catalog)
+           (count-views catalog)
+           (count-indexes catalog)
+           (count-fkeys catalog)))))
 
   ;; be sure to return the catalog itself
   catalog)
+
+
+(defmethod cleanup ((pgsql copy-pgsql) (catalog catalog) &key materialize-views)
+  "When there is a PostgreSQL error at prepare-pgsql-database step, we might
+   need to clean-up any view created in the source PostgreSQL connection for
+   the migration purpose."
+  (when materialize-views
+    (with-pgsql-transaction (:pgconn  (source-db pgsql))
+      (drop-pg-views materialize-views))))

test/mysql/db789.load

@@ -4,7 +4,7 @@ LOAD DATABASE
 
   WITH data only, truncate, create no tables
 
-  MATERIALIZE VIEWS proceed
+  MATERIALIZE VIEWS proceed, foo as $$ select 1 as a; $$
 
   INCLUDING ONLY TABLE NAMES MATCHING 'proceed'
 
@@ -13,5 +13,6 @@ LOAD DATABASE
   $$ drop schema if exists db789 cascade; $$,
   $$ create schema db789; $$,
   $$ create table db789.refrain (id char(1) primary key); $$,
-  $$ create table db789.proceed (id char(1) primary key); $$;
+  $$ create table db789.proceed (id char(1) primary key); $$,
+  $$ create table db789.foo (a integer primary key); $$;
 

test/pgsql-source.load

@@ -3,4 +3,12 @@ load database
      into pgsql://localhost/copy
 
   -- including only table names matching 'bits', ~/utilisateur/ in schema 'mysql'
+  including only table names matching ~/geolocations/ in schema 'public'
+
+  materialize views public.some_usps
+  as $$
+    select usps, geoid, aland, awater, aland_sqmi, awater_sqmi, location
+      from districts
+     where usps in ('MT', 'DE', 'AK', 'WY', 'PR', 'VT', 'SD', 'DC', 'ND');
+  $$
   ;