Added support for MySQL options

[clsql.git] / db-mysql / mysql-sql.lisp

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index db98e6361ee79986d450e02bd47a4400f9c19328..14d20bc8e245e30e3e084261a9e51f81a289e7b1 100644 (file)
--- 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
@@ -217,9 +258,10 @@
                                 (uffi:deref-array row '(:array
                                                         (* :unsigned-char))
                                                   i)
-                                result-types i
-                                (uffi:deref-array lengths '(:array :unsigned-long)
-                                                  i)))))
+                                (nth i result-types)
+                                 :length
+                                (uffi:deref-array lengths '(:array :unsigned-long) i)
+                                 :encoding (encoding database)))))
                     (when field-names
                       (result-field-names res-ptr))))
              (mysql-free-result res-ptr))
@@ -293,9 +335,10 @@
             (setf (car rest)
                   (convert-raw-field
                    (uffi:deref-array row '(:array (* :unsigned-char)) i)
-                   types
-                   i
-                   (uffi:deref-array lengths '(:array :unsigned-long) i))))
+                   (nth i types)
+                   :length
+                   (uffi:deref-array lengths '(:array :unsigned-long) i)
+                   :encoding (encoding database))))
       list)))
 
 
@@ -684,21 +727,21 @@
                    ((#.mysql-field-types#var-string #.mysql-field-types#string
                      #.mysql-field-types#tiny-blob #.mysql-field-types#blob
                      #.mysql-field-types#medium-blob #.mysql-field-types#long-blob)
-                    (uffi:convert-from-foreign-string buffer))
-                    (#.mysql-field-types#tiny
-                     (uffi:ensure-char-integer
-                      (uffi:deref-pointer buffer :byte)))
-                    (#.mysql-field-types#short
-                     (uffi:deref-pointer buffer :short))
-                    (#.mysql-field-types#long
-                     (uffi:deref-pointer buffer :int))
-                    #+64bit
-                    (#.mysql-field-types#longlong
+                    (uffi:convert-from-foreign-string buffer :encoding (encoding (database stmt))))
+                   (#.mysql-field-types#tiny
+                    (uffi:ensure-char-integer
+                     (uffi:deref-pointer buffer :byte)))
+                   (#.mysql-field-types#short
+                    (uffi:deref-pointer buffer :short))
+                   (#.mysql-field-types#long
+                    (uffi:deref-pointer buffer :int))
+                   #+64bit
+                   (#.mysql-field-types#longlong
                      (uffi:deref-pointer buffer :long))
-                    (#.mysql-field-types#float
-                     (uffi:deref-pointer buffer :float))
-                    (#.mysql-field-types#double
-                     (uffi:deref-pointer buffer :double))
+                   (#.mysql-field-types#float
+                    (uffi:deref-pointer buffer :float))
+                   (#.mysql-field-types#double
+                    (uffi:deref-pointer buffer :double))
                    ((#.mysql-field-types#time #.mysql-field-types#date
                                               #.mysql-field-types#datetime #.mysql-field-types#timestamp)
                     (let ((year (uffi:get-slot-value buffer 'mysql-time 'mysql::year))
@@ -706,7 +749,7 @@
                           (day (uffi:get-slot-value buffer 'mysql-time 'mysql::day))
                           (hour (uffi:get-slot-value buffer 'mysql-time 'mysql::hour))
                           (minute (uffi:get-slot-value buffer 'mysql-time 'mysql::minute))
-                  (second (uffi:get-slot-value buffer 'mysql-time 'mysql::second)))
+                          (second (uffi:get-slot-value buffer 'mysql-time 'mysql::second)))
                       (db-timestring
                        (make-time :year year :month month :day day :hour hour
                                   :minute minute :second second))))