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

@@ -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.

src/parsers/command-keywords.lisp

@@ -156,3 +156,4 @@
 
 (defrule kw-postgresql (or (~ "pgsql") (~ "postgresql")))
 (defrule kw-mysql (~ "mysql"))
+(defrule kw-mssql (~ "mssql"))

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

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))
 
 
 ;;;

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*)