From: Kevin Rosenberg <kevin@rosenberg.net>
Date: Mon, 15 Feb 2010 20:12:42 +0000 (-0700)
Subject: Added support for MySQL options
X-Git-Tag: v5.0.4~5
X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=4121952d2aa95c8611bf70b25b7772b5867c7666

Added support for MySQL options
Support sending options to MySQL using mysql_options, which occurs between
the API calls of mysql_init and mysql_real_connect.
---

diff --git a/ChangeLog b/ChangeLog
index c093212..ed7a0a9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2010-02-15  Kevin Rosenberg <kevin@rosenberg.net>
+	* db-mysql/mysql-{api,sql}.lisp: Support sending options
+	to MySQL using mysql_options, which occurs between the API calls
+	of mysql_init and mysql_real_connect.
+	
 2010-02-11  Kevin Rosenberg <kevin@rosenberg.net>
 	* Version 5.0.3
 	* multiple-files: Further internationalization. Change
diff --git a/db-mysql/mysql-api.lisp b/db-mysql/mysql-api.lisp
index 91fc3c5..60b5cbe 100644
--- a/db-mysql/mysql-api.lisp
+++ b/db-mysql/mysql-api.lisp
@@ -74,7 +74,47 @@
      :named-pipe
      :init-command
      :read-default-file
-     :read-default-group))
+     :read-default-group
+     :set-charset-dir
+     :set-charset-name
+     :local-infile
+     :protocol
+     :shared-memory-base-name
+     :read-timeout
+     :write-timeout
+     :use-result
+     :use-remote-connection
+     :use-embedded-connection
+     :guess-connection
+     :set-client-ip
+     :secure-auth
+     :report-data-truncation
+     :reconnect
+     :ssl-verify-server-cert))
+
+(defvar +mysql-option-parameter-map+
+  '((:connect-timeout . :uint-ptr)
+    (:compress . :none)
+    (:named-pipe . :none)
+    (:init-command . :char-ptr)
+    (:read-default-file . :char-ptr)
+    (:read-default-group . :char-ptr)
+    (:set-charset-dir . :char-ptr)
+    (:set-charset-name . :char-ptr)
+    (:local-infile . :uint-ptr)
+    (:protocol . :uint-ptr)
+    (:shared-memory-base-name . :char-ptr)
+    (:read-timeout . :uint-ptr)
+    (:write-timeout . :uint-ptr)
+    (:use-result . :none)
+    (:use-remote-connection . :none)
+    (:use-embedded-connection . :none)
+    (:guess-connection . :none)
+    (:set-client-ip . :char-ptr)
+    (:secure-auth . :boolean-ptr)
+    (:report-data-truncation . :boolean-ptr)
+    (:reconnect . :boolean-ptr)
+    (:ssl-verify-server-cert . :boolean-ptr)))
 
 (uffi:def-enum mysql-status
     (:ready
@@ -246,7 +286,7 @@
 (uffi:def-function "mysql_options"
   ((mysql mysql-mysql)
    (option mysql-option)
-   (arg :cstring))
+   (arg (* :void)))
   :module "mysql"
   :returning :int)
 
diff --git a/db-mysql/mysql-package.lisp b/db-mysql/mysql-package.lisp
index 5476478..926254d 100644
--- a/db-mysql/mysql-package.lisp
+++ b/db-mysql/mysql-package.lisp
@@ -146,5 +146,7 @@
      #:clsql-mysql-field-name
      #:clsql-mysql-field-type
      #:clsql-mysql-field-flags
+
+     #:+mysql-option-parameter-map+
      )
     (:documentation "This is the low-level interface MySQL."))
diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index d3fbc43..14d20bc 100644
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -96,7 +96,7 @@
 
 (defmethod database-name-from-spec (connection-spec (database-type (eql :mysql)))
   (check-connection-spec connection-spec database-type
-                         (host db user password &optional port))
+                         (host db user password &optional port options))
   (destructuring-bind (host db user password &optional port) connection-spec
     (declare (ignore password))
     (concatenate 'string
@@ -113,10 +113,49 @@
                      "")
                  "/" db "/" user)))
 
+(defun lookup-option-code (option)
+  (if (assoc option +mysql-option-parameter-map+)
+      (symbol-value (intern
+                     (concatenate 'string (symbol-name-default-case "mysql-option#")
+                                  (symbol-name option))
+                     (symbol-name '#:mysql)))
+      (progn
+        (warn "Unknown mysql option name ~A - ignoring.~%" option)
+        nil)))
+
+(defun set-mysql-options (mysql-ptr options)
+  (flet ((lookup-option-type (option)
+           (cdr (assoc option +mysql-option-parameter-map+))))
+    (dolist (option options)
+      (if (atom option)
+          (let ((option-code (lookup-option-code option)))
+            (when option-code
+              (mysql-options mysql-ptr option-code uffi:+null-cstring-pointer+)))
+          (destructuring-bind (name value) option
+            (let ((option-code (lookup-option-code name)))
+              (when option-code
+                (case (lookup-option-type name)
+                  (:none
+                   (mysql-options mysql-ptr option-code uffi:+null-cstring-pointer+))
+                  (:char-ptr
+                   (uffi:with-foreign-string (fs value)
+                       (mysql-options mysql-ptr option-code fs)))
+                  (:uint-ptr
+                   (uffi:with-foreign-object (fo :unsigned-int)
+                     (setf (uffi:deref-pointer fo :unsigned-int) value)
+                     (mysql-options mysql-ptr option-code fo)))
+                  (:boolean-ptr
+                   (uffi:with-foreign-object (fo :byte)
+                     (setf (uffi:deref-pointer fo :byte)
+                           (if (or (zerop value) (null value))
+                               0
+                               1))
+                     (mysql-options mysql-ptr option-code fo)))))))))))
+
 (defmethod database-connect (connection-spec (database-type (eql :mysql)))
   (check-connection-spec connection-spec database-type
-                         (host db user password &optional port))
-  (destructuring-bind (host db user password &optional port) connection-spec
+                         (host db user password &optional port options))
+  (destructuring-bind (host db user password &optional port options) connection-spec
     (let ((mysql-ptr (mysql-init (uffi:make-null-pointer 'mysql-mysql)))
           (socket nil))
       (if (uffi:null-pointer-p mysql-ptr)
@@ -130,6 +169,8 @@
                             (password-native password)
                             (db-native db)
                             (socket-native socket))
+          (when options
+            (set-mysql-options mysql-ptr options))
           (let ((error-occurred nil))
             (unwind-protect
                 (if (uffi:null-pointer-p