;;;; 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)
: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)))
db
(progn
(warn "Error setting ANSI mode for MySQL.")
(setf (database-mysql-ptr database) nil)
t)
-
-(defmethod database-query (query-expression (database mysql-database)
- result-types field-names)
- (declare (optimize (speed 3) (safety 0) (debug 0) (space 0)))
- (let ((mysql-ptr (database-mysql-ptr database)))
- (uffi:with-cstring (query-native query-expression)
- (if (zerop (mysql-real-query mysql-ptr query-native
- (expression-length query-expression)))
- (let ((res-ptr (mysql-use-result mysql-ptr)))
- (if res-ptr
- (unwind-protect
- (let ((num-fields (mysql-num-fields res-ptr)))
- (declare (fixnum num-fields))
- (setq result-types (canonicalize-types
- result-types res-ptr))
- (values
- (loop for row = (mysql-fetch-row res-ptr)
- for lengths = (mysql-fetch-lengths res-ptr)
- until (uffi:null-pointer-p row)
- collect
- (do* ((rlist (make-list num-fields))
- (i 0 (1+ i))
- (pos rlist (cdr pos)))
- ((= i num-fields) rlist)
- (declare (fixnum i))
- (setf (car pos)
- (convert-raw-field
- (uffi:deref-array row '(:array
- (* :unsigned-char))
- i)
- result-types i
- (uffi:deref-array lengths '(:array :unsigned-long)
- i)))))
- (when field-names
- (result-field-names res-ptr))))
- (mysql-free-result res-ptr))
- (error 'sql-database-data-error
- :database database
- :expression query-expression
- :error-id (mysql-errno mysql-ptr)
- :message (mysql-error-string mysql-ptr))))
- (error 'sql-database-data-error
- :database database
- :expression query-expression
- :error-id (mysql-errno mysql-ptr)
- :message (mysql-error-string mysql-ptr))))))
-
(defmethod database-execute-command (sql-expression (database mysql-database))
(uffi:with-cstring (sql-native sql-expression)
(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)))
t
(error 'sql-database-data-error
:database database
:message (mysql-error-string mysql-ptr))))))
+(defmethod database-query (query-expression (database mysql-database)
+ result-types field-names)
+ (declare (optimize (speed 3) (safety 0) (debug 0) (space 0)))
+ (let ((mysql-ptr (database-mysql-ptr database)))
+ (declare (type mysql-mysql-ptr-def mysql-ptr))
+ (when (database-execute-command query-expression database)
+ (let ((res-ptr (mysql-use-result mysql-ptr)))
+ (declare (type mysql-mysql-res-ptr-def res-ptr))
+ (if (and res-ptr (not (uffi:null-pointer-p res-ptr)))
+ (unwind-protect
+ (let ((num-fields (mysql-num-fields res-ptr)))
+ (declare (fixnum num-fields))
+ (setq result-types (canonicalize-types
+ result-types res-ptr))
+ (values
+ (loop for row = (mysql-fetch-row res-ptr)
+ for lengths = (mysql-fetch-lengths res-ptr)
+ until (uffi:null-pointer-p row)
+ collect
+ (do* ((rlist (make-list num-fields))
+ (i 0 (1+ i))
+ (pos rlist (cdr pos)))
+ ((= i num-fields) rlist)
+ (declare (fixnum i))
+ (setf (car pos)
+ (convert-raw-field
+ (uffi:deref-array row '(:array
+ (* :unsigned-char))
+ i)
+ result-types i
+ (uffi:deref-array lengths '(:array :unsigned-long)
+ i)))))
+ (when field-names
+ (result-field-names res-ptr))))
+ (mysql-free-result res-ptr))
+ (unless (zerop (mysql-errno mysql-ptr))
+ ;;from http://dev.mysql.com/doc/refman/5.0/en/mysql-field-count.html
+ ;; if mysql_use_result or mysql_store_result return a null ptr,
+ ;; we use a mysql_errno check to see if it had a problem or just
+ ;; was a query without a result. If no error, just return nil.
+ (error 'sql-database-data-error
+ :database database
+ :expression query-expression
+ :error-id (mysql-errno mysql-ptr)
+ :message (mysql-error-string mysql-ptr))))))))
+
+
(defstruct mysql-result-set
(res-ptr (uffi:make-null-pointer 'mysql-mysql-res) :type mysql-mysql-res-ptr-def)
(types nil :type list)
(defmethod database-query-result-set ((query-expression string)
(database mysql-database)
&key full-set result-types)
- (uffi:with-cstring (query-native query-expression)
- (let ((mysql-ptr (database-mysql-ptr database)))
- (declare (type mysql-mysql-ptr-def mysql-ptr))
- (if (zerop (mysql-real-query mysql-ptr query-native
- (expression-length query-expression)))
- (let ((res-ptr (if full-set
- (mysql-store-result mysql-ptr)
- (mysql-use-result mysql-ptr))))
- (declare (type mysql-mysql-res-ptr-def res-ptr))
- (if (not (uffi:null-pointer-p res-ptr))
- (let* ((num-fields (mysql-num-fields res-ptr))
- (result-set (make-mysql-result-set
- :res-ptr res-ptr
- :num-fields num-fields
- :full-set full-set
- :types
- (canonicalize-types
- result-types res-ptr))))
- (if full-set
- (values result-set
- num-fields
- (mysql-num-rows res-ptr))
- (values result-set
- num-fields)))
- (error 'sql-database-data-error
- :database database
- :expression query-expression
- :error-id (mysql-errno mysql-ptr)
- :message (mysql-error-string mysql-ptr))))
- (error 'sql-database-data-error
- :database database
- :expression query-expression
- :error-id (mysql-errno mysql-ptr)
- :message (mysql-error-string mysql-ptr))))))
+ (let ((mysql-ptr (database-mysql-ptr database)))
+ (declare (type mysql-mysql-ptr-def mysql-ptr))
+ (when (database-execute-command query-expression database)
+ (let ((res-ptr (if full-set
+ (mysql-store-result mysql-ptr)
+ (mysql-use-result mysql-ptr))))
+ (declare (type mysql-mysql-res-ptr-def res-ptr))
+ (if (not (uffi:null-pointer-p res-ptr))
+ (let* ((num-fields (mysql-num-fields res-ptr))
+ (result-set (make-mysql-result-set
+ :res-ptr res-ptr
+ :num-fields num-fields
+ :full-set full-set
+ :types
+ (canonicalize-types
+ result-types res-ptr))))
+ (if full-set
+ (values result-set
+ num-fields
+ (mysql-num-rows res-ptr))
+ (values result-set
+ num-fields)))
+ (error 'sql-database-data-error
+ :database database
+ :expression query-expression
+ :error-id (mysql-errno mysql-ptr)
+ :message (mysql-error-string mysql-ptr))))
+ )))
(defmethod database-dump-result-set (result-set (database mysql-database))
(mysql-free-result (mysql-result-set-res-ptr result-set))
: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)))
(mysql-stmt-close stmt)
(error 'sql-database-error
:error-id (mysql-errno mysql-ptr)
projects / clsql.git / blobdiff