+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
: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
(uffi:def-function "mysql_options"
((mysql mysql-mysql)
(option mysql-option)
- (arg :cstring))
+ (arg (* :void)))
:module "mysql"
:returning :int)
(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
"")
"/" 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)
(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