+(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)))))))))))
+