From 20a85055f40b9a4fa3b6925eb7de74250cd2479a Mon Sep 17 00:00:00 2001
From: Dimitri Fontaine <dim@tapoueh.org>
Date: Sat, 12 Aug 2017 23:43:22 +0200
Subject: [PATCH] Implement support for MS SQL set parameters.

It is sometimes needed to tweak MS SQL server parameters, such as the
textsize parameters which allows fetching the whole set of bytes of a text
of binary column (not kidding).

Now it's possible to add such a line in the load file:

  set mssql parameters textsize to '104857600'

Fixes #603.
---
 src/params.lisp                     |  2 ++
 src/parsers/command-keywords.lisp   |  1 +
 src/parsers/command-mssql.lisp      | 16 ++++++++++++++--
 src/sources/mssql/mssql-schema.lisp |  8 ++++++--
 src/utils/threads.lisp              |  1 +
 5 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/src/params.lisp b/src/params.lisp
index fae77b8..bb2e095 100644
--- a/src/params.lisp
+++ b/src/params.lisp
@@ -26,6 +26,7 @@
            #:*prefetch-rows*
 	   #:*pg-settings*
            #:*mysql-settings*
+           #:*mssql-settings*
 	   #:*default-tmpdir*
 	   #:init-params-from-environment
 	   #:getenv-default
@@ -142,6 +143,7 @@
 
 (defparameter *pg-settings* nil "An alist of GUC names and values.")
 (defparameter *mysql-settings* nil "An alist of GUC names and values.")
+(defparameter *mssql-settings* nil "An alist of GUC names and values.")
 
 ;;;
 ;;; Archive processing: downloads and unzip.
diff --git a/src/parsers/command-keywords.lisp b/src/parsers/command-keywords.lisp
index 941964d..fb0576a 100644
--- a/src/parsers/command-keywords.lisp
+++ b/src/parsers/command-keywords.lisp
@@ -156,3 +156,4 @@
 
 (defrule kw-postgresql (or (~ "pgsql") (~ "postgresql")))
 (defrule kw-mysql (~ "mysql"))
+(defrule kw-mssql (~ "mssql"))
diff --git a/src/parsers/command-mssql.lisp b/src/parsers/command-mssql.lisp
index f583782..2b2dabf 100644
--- a/src/parsers/command-mssql.lisp
+++ b/src/parsers/command-mssql.lisp
@@ -65,11 +65,19 @@
     (destructuring-bind (excl1 excls) source
       (cons :excluding (list* excl1 excls)))))
 
+
+;;;
+;;; MSSQL SET parameters, because sometimes we need that
+;;;
+(defrule mssql-gucs (and kw-set kw-mssql kw-parameters generic-option-list)
+  (:lambda (mygucs) (cons :mssql-gucs (fourth mygucs))))
+
 
 ;;;
 ;;; Allow clauses to appear in any order
 ;;;
 (defrule load-mssql-optional-clauses (* (or mssql-options
+                                            mssql-gucs
                                             gucs
                                             casts
                                             alter-schema
@@ -139,7 +147,8 @@
 
 (defun lisp-code-for-loading-from-mssql (ms-db-conn pg-db-conn
                                          &key
-                                           gucs casts before after options
+                                           gucs mssql-gucs
+                                           casts before after options
                                            alter-schema alter-table
                                            including excluding)
   `(lambda ()
@@ -149,6 +158,7 @@
 
      (let* ((*default-cast-rules* ',*mssql-default-cast-rules*)
             (*cast-rules*         ',casts)
+            (*mssql-settings*     ',mssql-gucs)
             ,@(pgsql-connection-bindings pg-db-conn gucs)
             ,@(batch-control-bindings options)
             ,@(identifier-case-binding options)
@@ -173,7 +183,8 @@
   (:lambda (source)
     (bind (((ms-db-uri pg-db-uri
                        &key
-                       gucs casts before after alter-schema alter-table
+                       gucs mssql-gucs casts before after
+                       alter-schema alter-table
                        including excluding options)
             source))
       (cond (*dry-run*
@@ -181,6 +192,7 @@
             (t
              (lisp-code-for-loading-from-mssql ms-db-uri pg-db-uri
                                                :gucs gucs
+                                               :mssql-gucs mssql-gucs
                                                :casts casts
                                                :before before
                                                :after after
diff --git a/src/sources/mssql/mssql-schema.lisp b/src/sources/mssql/mssql-schema.lisp
index d43fd3f..fc39734 100644
--- a/src/sources/mssql/mssql-schema.lisp
+++ b/src/sources/mssql/mssql-schema.lisp
@@ -21,6 +21,11 @@
                                             (db-user msconn)
                                             (db-pass msconn)
                                             (db-host msconn)))
+  ;; apply mysql-settings, if any
+  (loop :for (name . value) :in *mssql-settings*
+     :for sql := (format nil "set ~a ~a;" name value)
+     :do (query msconn sql))
+
   ;; return the connection object
   msconn)
 
@@ -40,8 +45,7 @@
 (defun mssql-query (query)
   "Execute given QUERY within the current *connection*, and set proper
    defaults for pgloader."
-  (log-message :sql "MSSQL: sending query: ~a" query)
-  (mssql:query query :connection (conn-handle *mssql-db*)))
+  (query *mssql-db* query))
 
 
 ;;;
diff --git a/src/utils/threads.lisp b/src/utils/threads.lisp
index c950fc5..f09d362 100644
--- a/src/utils/threads.lisp
+++ b/src/utils/threads.lisp
@@ -14,6 +14,7 @@
                             (*prefetch-rows*      . ,*prefetch-rows*)
 			    (*pg-settings*        . ',*pg-settings*)
 			    (*mysql-settings*     . ',*mysql-settings*)
+			    (*mssql-settings*     . ',*mssql-settings*)
                             (*root-dir*           . ,*root-dir*)
                             (*fd-path-root*       . ,*fd-path-root*)
                             (*client-min-messages* . ,*client-min-messages*)