;;;; Purpose: High-level MySQL interface using UFFI
;;;; Date Started: Feb 2002
;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002-2009 by Kevin M. Rosenberg
+;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
(in-package #:clsql-mysql)
-;; if we have :sb-unicode, UFFI will treat :cstring as a UTF-8 string
-(defun expression-length (query-expression)
- (length #+sb-unicode (sb-ext:string-to-octets query-expression
- :external-format :utf8)
- #-sb-unicode query-expression))
-
;;; Field conversion functions
(defun result-field-names (res-ptr)
(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
:mysql-ptr mysql-ptr))
(cmd "SET SESSION sql_mode='ANSI'"))
(uffi:with-cstring (cmd-cs cmd)
- (if (zerop (mysql-real-query mysql-ptr cmd-cs (expression-length cmd)))
+ (if (zerop (mysql-real-query mysql-ptr cmd-cs (uffi:foreign-encoded-octet-count
+ cmd :encoding (encoding db))))
db
(progn
(warn "Error setting ANSI mode for MySQL.")
(let ((mysql-ptr (database-mysql-ptr database)))
(declare (type mysql-mysql-ptr-def mysql-ptr))
(if (zerop (mysql-real-query mysql-ptr sql-native
- (expression-length sql-expression)))
+ (uffi:foreign-encoded-octet-count
+ sql-expression :encoding (encoding database))))
t
(error 'sql-database-data-error
:database database
(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))
(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)))
:message (mysql-error-string mysql-ptr)))
(uffi:with-cstring (native-query sql-stmt)
- (unless (zerop (mysql-stmt-prepare stmt native-query (expression-length sql-stmt)))
+ (unless (zerop (mysql-stmt-prepare stmt native-query (uffi:foreign-encoded-octet-count
+ sql-stmt :encoding (encoding database))))
(mysql-stmt-close stmt)
(error 'sql-database-error
:error-id (mysql-errno mysql-ptr)
((#.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))
(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))))
projects / clsql.git / blobdiff