X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-mysql%2Fmysql-sql.lisp;h=503da2a71ddd5f3a16150e76248f67e94ea9e6cb;hb=1a446890f95ab363af82529a133546d722ef21b1;hp=d3fbc43a006ed7031910a478a2439d4199ec90b5;hpb=fe6d36c16c61c855fc3b0c0c7c07f3cf3de4241d;p=clsql.git

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index d3fbc43..503da2a 100644
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -96,9 +96,9 @@
 
 (defmethod database-name-from-spec (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
-    (declare (ignore password))
+                         (host db user password &optional port options))
+  (destructuring-bind (host db user password &optional port options) connection-spec
+    (declare (ignore password options))
     (concatenate 'string
                  (etypecase host
                    (null "localhost")
@@ -113,10 +113,57 @@
                      "")
                  "/" 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
+                   (if (stringp value)
+                       (uffi:with-foreign-string (fs value)
+                           (mysql-options mysql-ptr option-code fs))
+                       (warn "Expecting string argument for mysql option ~A, got ~A ~
+- ignoring.~%"
+                             name value)))
+                  (:uint-ptr
+                   (if (integerp value)
+                       (uffi:with-foreign-object (fo :unsigned-int)
+                         (setf (uffi:deref-pointer fo :unsigned-int) value)
+                         (mysql-options mysql-ptr option-code fo))
+                       (warn "Expecting integer argument for mysql option ~A, got ~A ~
+- ignoring.~%"
+                             name value)))
+                  (: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 +177,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
@@ -438,6 +487,12 @@
                         (%sequence-name-to-table sequence-name))
            database :auto nil))))
 
+(defmethod database-last-auto-increment-id ((database mysql-database) table column)
+  (declare (ignore table column))
+  (car (query "SELECT LAST_INSERT_ID();"
+             :flatp t :field-names nil
+             :database database)))
+
 (defmethod database-create (connection-spec (type (eql :mysql)))
   (destructuring-bind (host name user password) connection-spec
     (let ((database (database-connect (list host "" user password)
@@ -462,7 +517,8 @@
     t))
 
 (defmethod database-list (connection-spec (type (eql :mysql)))
-  (destructuring-bind (host name user password &optional port) connection-spec
+  (destructuring-bind (host name user password &optional port options) connection-spec
+    (declare (ignore options))
     (let ((database (database-connect (list host (or name "mysql")
                                             user password port) type)))
       (unwind-protect