Implement MATERIALIZE VIEWS support for MS SQL, and distribute.

The latter is not tested yet, but should have no impact if not used. Given
how rare it is that I get a chance to play around with a MS SQL instance
anyway, it might be better to push blind changes for it when it doesn't
impact existing features…

Author: dimitri

src/parsers/command-mssql.lisp

@@ -83,6 +83,8 @@
                                             casts
                                             alter-schema
                                             alter-table
+                                            materialize-views
+                                            distribute-commands
                                             before-load
                                             after-load
                                             including-like-in-schema
@@ -139,7 +141,8 @@
 (defun lisp-code-for-loading-from-mssql (ms-db-conn pg-db-conn
                                          &key
                                            gucs mssql-gucs
-                                           casts before after options
+                                           casts before after
+                                           options distribute views
                                            alter-schema alter-table
                                            including excluding
                                            &allow-other-keys)
@@ -167,6 +170,8 @@
                       :excluding ',excluding
                       :alter-schema ',alter-schema
                       :alter-table ',alter-table
+                      :materialize-views ',views
+                      :distribute ',distribute
                       :set-table-oids t
                       :on-error-stop on-error-stop
                       ,@(remove-batch-control-option options))
@@ -177,8 +182,8 @@
   (:lambda (source)
     (bind (((ms-db-uri pg-db-uri
                        &key
-                       gucs mssql-gucs casts before after
-                       alter-schema alter-table
+                       gucs mssql-gucs casts views before after
+                       alter-schema alter-table distribute
                        including excluding options)
             source))
       (cond (*dry-run*
@@ -188,10 +193,12 @@
                                                :gucs gucs
                                                :mssql-gucs mssql-gucs
                                                :casts casts
+                                               :views views
                                                :before before
                                                :after after
                                                :alter-schema alter-schema
                                                :alter-table alter-table
+                                               :distribute distribute
                                                :options options
                                                :including including
                                                :excluding excluding))))))

src/sources/mssql/mssql-cast-rules.lisp

@@ -88,6 +88,9 @@
   datetime-precision
   character-set-name collation-name)
 
+(defmethod field-name ((field mssql-column) &key)
+  (mssql-column-name field))
+
 (defmethod mssql-column-ctype ((col mssql-column))
   "Build the ctype definition from the full mssql-column information."
   (let ((type (mssql-column-type col)))

src/sources/mssql/mssql-schema.lisp

@@ -213,3 +213,43 @@
   (loop :for col :in columns
      :collect (with-slots (name type) col
                 (get-column-sql-expression name type))))
+
+
+
+;;;
+;;; Materialize Views support
+;;;
+(defun create-ms-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 "MS SQL: ~a" sql)
+                 (mssql-query sql)))))))
+
+(defun drop-ms-views (views-alist)
+  "See `create-ms-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)
+         (mssql-query sql))))))

src/sources/mssql/mssql.lisp

@@ -72,30 +72,63 @@
                              including
                              excluding)
   "MS SQL 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
                           :section :pre)
-      (with-connection (*mssql-db* (source-db mssql))
-        (list-all-columns catalog
-                          :including including
-                          :excluding excluding)
+    (with-connection (*mssql-db* (source-db mssql))
+      ;; If asked to MATERIALIZE VIEWS, now is the time to create them in MS
+      ;; SQL, when given definitions rather than existing view names.
+      (when (and materialize-views (not (eq :all materialize-views)))
+        (create-ms-views materialize-views))
+
+      (list-all-columns catalog
+                        :including including
+                        :excluding excluding)
+
+      ;; fetch view (and their columns) metadata, covering comments too
+      (let* ((view-names (unless (eq :all materialize-views)
+                           (mapcar #'car materialize-views)))
+             (including
+              (loop :for (schema-name . view-name) :in view-names
+                 :do (let* ((schema-name (or schema-name "dbo"))
+                            (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 view-name (cdr schema-entry))))))
+        (cond (view-names
+               (list-all-columns catalog
+                                 :including including
+                                 :table-type :view))
 
-        (when create-indexes
-          (list-all-indexes catalog
-                            :including including
-                            :excluding excluding))
+              ((eq :all materialize-views)
+               (list-all-columns catalog :table-type :view))))
 
-        (when foreign-keys
-          (list-all-fkeys catalog
+      (when create-indexes
+        (list-all-indexes 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))))
+      (when 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))))
 
   ;; be sure to return the catalog itself
   catalog)
 
+
+(defmethod cleanup ((mssql copy-mssql) (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 MS SQL connection for the
+   migration purpose."
+  (when materialize-views
+    (with-connection (*mssql-db* (source-db mssql))
+      (drop-ms-views materialize-views))))