pgloader/src/sources/mssql/mssql.lisp

;;;
;;; Tools to handle the MS SQL Database
;;;

(in-package :pgloader.source.mssql)

(defmethod map-rows ((mssql copy-mssql) &key process-row-fn)
  "Extract Mssql data and call PROCESS-ROW-FN function with a single
   argument (a list of column values) for each row."
  (with-connection (*mssql-db* (source-db mssql))
    (let* ((sql  (format nil "SELECT ~{~a~^, ~} FROM [~a].[~a];"
                         (get-column-list mssql)
                         (schema-source-name (table-schema (source mssql)))
                         (table-source-name (source mssql)))))
      (log-message :debug "~a" sql)
      (handler-bind
          ((babel-encodings:end-of-input-in-character
            #'(lambda (c)
                (update-stats :data (target mssql) :errs 1)
                (log-message :error "~a" c)
                (invoke-restart 'mssql::use-nil)))

           (babel-encodings:character-decoding-error
            #'(lambda (c)
                (update-stats :data (target mssql) :errs 1)
                (let ((encoding
                       (babel-encodings:character-coding-error-encoding c))
                      (position
                       (babel-encodings:character-coding-error-position c))
                      (character
                       (aref (babel-encodings:character-coding-error-buffer c)
                             (babel-encodings:character-coding-error-position c))))
                  (log-message :error
                               "~a: Illegal ~a character starting at position ~a: ~a."
                               (table-schema (source mssql))
                               encoding
                               position
                               character))
                (invoke-restart 'mssql::use-nil))))
        (mssql::map-query-results sql
                                  :row-fn process-row-fn
                                  :connection (conn-handle *mssql-db*))))))

(defmethod copy-column-list ((mssql copy-mssql))
  "We are sending the data in the MS SQL columns ordering here."
  (mapcar #'apply-identifier-case (mapcar #'mssql-column-name (fields mssql))))

(defmethod fetch-metadata ((mssql copy-mssql)
                           (catalog catalog)
                           &key
                             materialize-views
                             create-indexes
                             foreign-keys
                             including
                             excluding)
  "MS SQL introspection to prepare the migration."
  (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))
      ;; 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-matviews materialize-views mssql)
        (format t "[fetch-metadata] Materialize Views: ~A~%" materialize-views)
      )

      (format t "[fetch-metadata] Original including: ~A~%" including)
      (fetch-columns catalog mssql
                     :including including
                     :excluding excluding)

      ;; fetch view (and their columns) metadata, covering comments too
      (let* ((view-names (progn
                      (let ((names (unless (eq :all materialize-views)
                                     (mapcar #'matview-source-name materialize-views))))
                        ;; Debugging statement
                        (format t "[fetch-metadata] Debugging view-names: ~A~%" names)
                        ;; Return the computed value for the let* binding
                        names))))
             (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))))))
        (format t "[fetch-metadata] New including: ~A~%" including)
        (cond (view-names
               (fetch-columns catalog mssql
                              :including including
                              :excluding excluding
                              :table-type :view))

              ((eq :all materialize-views)
               (fetch-columns catalog mssql :table-type :view))))

      (when create-indexes
        (fetch-indexes catalog mssql
                       :including including
                       :excluding excluding))

      (when foreign-keys
        (fetch-foreign-keys catalog mssql
                            :including including
                            :excluding excluding))

      ;; 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 ((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-matviews materialize-views mssql))))