* db-mysql/mysql-client-info.lisp: Recognize MySQL 5
* db-mysql/mysql-sql.lisp: Add support for views in MySQL 5
+11 Nov 2005 Kevin Rosenberg <kevin@rosenberg.net>
+ * db-mysql/mysql-client-info.lisp: Recognize MySQL 5
+ * db-mysql/mysql-sql.lisp: Add support for views in MySQL 5
+
7 Nov 2005 Kevin Rosenberg <kevin@rosenberg.net>
* src/time.lisp: Apply patch from Aleksandar Bakic for ROLL
function.
7 Nov 2005 Kevin Rosenberg <kevin@rosenberg.net>
* src/time.lisp: Apply patch from Aleksandar Bakic for ROLL
function.
;;;;
;;;; Name: mysql-api.lisp
;;;; Purpose: Low-level MySQL interface using UFFI
;;;;
;;;; Name: mysql-api.lisp
;;;; Purpose: Low-level MySQL interface using UFFI
-;;;; Programmers: Kevin M. Rosenberg based on
-;;;; Original code by Pierre R. Mai
+;;;; Programmers: Kevin M. Rosenberg based on
+;;;; Original code by Pierre R. Mai
;;;; Date Started: Feb 2002
;;;;
;;;; $Id$
;;;; Date Started: Feb 2002
;;;;
;;;; $Id$
;;;; that are used in a few routines.
;;;; - Removed all references to interiors of C-structions, this will
;;;; increase robustness when MySQL's internal structures change.
;;;; that are used in a few routines.
;;;; - Removed all references to interiors of C-structions, this will
;;;; increase robustness when MySQL's internal structures change.
;;;; Type definitions
;;; Basic Types
;;;; Type definitions
;;; Basic Types
(decimals :unsigned-int)
(type mysql-field-types))
(decimals :unsigned-int)
(type mysql-field-types))
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-struct mysql-field
(name (* :char))
(org_name (* :char))
(uffi:def-struct mysql-field
(name (* :char))
(org_name (* :char))
(charsetnr :unsigned-int)
(type mysql-field-types))
(charsetnr :unsigned-int)
(type mysql-field-types))
(uffi:def-struct mysql-time
(year :unsigned-int)
(month :unsigned-int)
(uffi:def-struct mysql-time
(year :unsigned-int)
(month :unsigned-int)
:read-default-group))
(uffi:def-enum mysql-status
:read-default-group))
(uffi:def-enum mysql-status
:get-result
:use-result))
:get-result
:use-result))
(handle (:struct-pointer mysql-mysql))
(eof mysql-bool))
(handle (:struct-pointer mysql-mysql))
(eof mysql-bool))
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-enum mysql-field-types
(uffi:def-enum mysql-field-types
:get-result
:use-result))
:get-result
:use-result))
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-struct mysql-bind
(length (* :unsigned-long))
(is-null (* mysql-bool))
(uffi:def-struct mysql-bind
(length (* :unsigned-long))
(is-null (* mysql-bool))
(declaim (inline mysql-init))
(uffi:def-function "mysql_init"
((mysql (* mysql-mysql)))
(declaim (inline mysql-init))
(uffi:def-function "mysql_init"
((mysql (* mysql-mysql)))
:returning (* mysql-mysql))
#-mysql-client-v4
:returning (* mysql-mysql))
#-mysql-client-v4
:module "clsql-mysql"
:returning :unsigned-int)
:module "clsql-mysql"
:returning :unsigned-int)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-foreign-type mysql-stmt-ptr :pointer-void)
(uffi:def-foreign-type mysql-stmt-ptr :pointer-void)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_init"
((res (* mysql-mysql-res)))
:module "clsql-mysql"
:returning mysql-stmt-ptr)
(uffi:def-function "mysql_stmt_init"
((res (* mysql-mysql-res)))
:module "clsql-mysql"
:returning mysql-stmt-ptr)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_prepare"
((stmt mysql-stmt-ptr)
(query :cstring)
(uffi:def-function "mysql_stmt_prepare"
((stmt mysql-stmt-ptr)
(query :cstring)
:module "clsql-mysql"
:returning :int)
:module "clsql-mysql"
:returning :int)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_param_count"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :unsigned-int)
(uffi:def-function "mysql_stmt_param_count"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :unsigned-int)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_bind_param"
((stmt mysql-stmt-ptr)
(bind (* mysql-bind)))
:module "clsql-mysql"
:returning :short)
(uffi:def-function "mysql_stmt_bind_param"
((stmt mysql-stmt-ptr)
(bind (* mysql-bind)))
:module "clsql-mysql"
:returning :short)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_bind_result"
((stmt mysql-stmt-ptr)
(bind (* mysql-bind)))
:module "clsql-mysql"
:returning :short)
(uffi:def-function "mysql_stmt_bind_result"
((stmt mysql-stmt-ptr)
(bind (* mysql-bind)))
:module "clsql-mysql"
:returning :short)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_result_metadata"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning (* mysql-mysql-res))
(uffi:def-function "mysql_stmt_result_metadata"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning (* mysql-mysql-res))
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_execute"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :int)
(uffi:def-function "mysql_stmt_execute"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :int)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_store_result"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :int)
(uffi:def-function "mysql_stmt_store_result"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :int)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_fetch"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :int)
(uffi:def-function "mysql_stmt_fetch"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :int)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_free_result"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :short)
(uffi:def-function "mysql_stmt_free_result"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :short)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_close"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :short)
(uffi:def-function "mysql_stmt_close"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :short)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_errno"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :unsigned-int)
(uffi:def-function "mysql_stmt_errno"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
:returning :unsigned-int)
+#+(or mysql-client-v4.1 mysql-client-v5)
(uffi:def-function "mysql_stmt_error"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
(uffi:def-function "mysql_stmt_error"
((stmt mysql-stmt-ptr))
:module "clsql-mysql"
(declaim (inline mysql-num-fields))
(declaim (inline mysql-num-fields))
-(uffi:def-function "mysql_num_fields"
+(uffi:def-function "mysql_num_fields"
((res (* mysql-mysql-res)))
:returning :unsigned-int
:module "mysql")
((res (* mysql-mysql-res)))
:returning :unsigned-int
:module "mysql")
(declaim (inline clsql-mysql-eof))
(uffi:def-function ("mysql_eof" clsql-mysql-eof)
((res (* mysql-mysql-res)))
(declaim (inline clsql-mysql-eof))
(uffi:def-function ("mysql_eof" clsql-mysql-eof)
((res (* mysql-mysql-res)))
(setf *mysql-client-info* (uffi:convert-from-cstring (mysql-get-client-info)))
(setf *mysql-client-info* (uffi:convert-from-cstring (mysql-get-client-info)))
(when (and (stringp *mysql-client-info*)
(plusp (length *mysql-client-info*)))
(cond
(when (and (stringp *mysql-client-info*)
(plusp (length *mysql-client-info*)))
(cond
(when (and (>= (length *mysql-client-info*) 3)
(string-equal "4.1" *mysql-client-info* :end2 3))
(pushnew :mysql-client-v4.1 cl:*features*)))
(when (and (>= (length *mysql-client-info*) 3)
(string-equal "4.1" *mysql-client-info* :end2 3))
(pushnew :mysql-client-v4.1 cl:*features*)))
+ ((eql (schar *mysql-client-info* 0) #\5)
+ (pushnew :mysql-client-v5 cl:*features*))
(t
(error "Unknown mysql client version '~A'." *mysql-client-info*)))))
(t
(error "Unknown mysql client version '~A'." *mysql-client-info*)))))
(type (uffi:get-slot-value field 'mysql-field 'type)))
(push
(case type
(type (uffi:get-slot-value field 'mysql-field 'type)))
(push
(case type
- ((#.mysql-field-types#tiny
+ ((#.mysql-field-types#tiny
#.mysql-field-types#short
#.mysql-field-types#int24)
(if unsigned
#.mysql-field-types#short
#.mysql-field-types#int24)
(if unsigned
(defclass mysql-database (database)
((mysql-ptr :accessor database-mysql-ptr :initarg :mysql-ptr
(defclass mysql-database (database)
((mysql-ptr :accessor database-mysql-ptr :initarg :mysql-ptr
- :type mysql-mysql-ptr-def)))
+ :type mysql-mysql-ptr-def)
+ (server-info :accessor database-server-info :initarg :server-info
+ :type string)))
(defmethod database-type ((database mysql-database))
:mysql)
(defmethod database-type ((database mysql-database))
:mysql)
(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))
(destructuring-bind (host db user password &optional port) connection-spec
(declare (ignore password))
(etypecase host
(null "localhost")
(pathname (namestring host))
(string host))
(etypecase host
(null "localhost")
(pathname (namestring host))
(string host))
(concatenate 'string
":"
(etypecase port
(concatenate 'string
":"
(etypecase port
(socket-native socket))
(let ((error-occurred nil))
(unwind-protect
(socket-native socket))
(let ((error-occurred nil))
(unwind-protect
- (if (uffi:null-pointer-p
- (mysql-real-connect
+ (if (uffi:null-pointer-p
+ (mysql-real-connect
mysql-ptr host-native user-native password-native
db-native
(etypecase port
mysql-ptr host-native user-native password-native
db-native
(etypecase port
:error-id (mysql-errno mysql-ptr)
:message (mysql-error-string mysql-ptr)))
(make-instance 'mysql-database
:error-id (mysql-errno mysql-ptr)
:message (mysql-error-string mysql-ptr)))
(make-instance 'mysql-database
- :name (database-name-from-spec connection-spec
- database-type)
- :database-type :mysql
- :connection-spec connection-spec
- :mysql-ptr mysql-ptr))
+ :name (database-name-from-spec connection-spec
+ database-type)
+ :database-type :mysql
+ :connection-spec connection-spec
+ :server-info (uffi:convert-from-cstring
+ (mysql:mysql-get-server-info mysql-ptr))
+ :mysql-ptr mysql-ptr))
(when error-occurred (mysql-close mysql-ptr)))))))))
(when error-occurred (mysql-close mysql-ptr)))))))))
-(defmethod database-query (query-expression (database mysql-database)
+(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)
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
+ (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))
(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
+ (setq result-types (canonicalize-types
result-types num-fields
res-ptr))
(values
result-types num-fields
res-ptr))
(values
(pos rlist (cdr pos)))
((= i num-fields) rlist)
(declare (fixnum i))
(pos rlist (cdr pos)))
((= i num-fields) rlist)
(declare (fixnum i))
(convert-raw-field
(uffi:deref-array row '(:array
(* :unsigned-char))
(convert-raw-field
(uffi:deref-array row '(:array
(* :unsigned-char))
(uffi:with-cstring (sql-native sql-expression)
(let ((mysql-ptr (database-mysql-ptr database)))
(declare (type mysql-mysql-ptr-def mysql-ptr))
(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
+ (if (zerop (mysql-real-query mysql-ptr sql-native
(expression-length sql-expression)))
t
(error 'sql-database-data-error
(expression-length sql-expression)))
t
(error 'sql-database-data-error
:message (mysql-error-string mysql-ptr))))))
:message (mysql-error-string mysql-ptr))))))
-(defstruct mysql-result-set
+(defstruct mysql-result-set
(res-ptr (uffi:make-null-pointer 'mysql-mysql-res) :type mysql-mysql-res-ptr-def)
(types nil :type list)
(num-fields 0 :type fixnum)
(res-ptr (uffi:make-null-pointer 'mysql-mysql-res) :type mysql-mysql-res-ptr-def)
(types nil :type list)
(num-fields 0 :type fixnum)
:num-fields num-fields
:full-set full-set
:types
:num-fields num-fields
:full-set full-set
:types
(if full-set
(values result-set
num-fields
(if full-set
(values result-set
num-fields
(loop for i from 0 below (mysql-result-set-num-fields result-set)
for rest on list
do
(loop for i from 0 below (mysql-result-set-num-fields result-set)
for rest on list
do
(convert-raw-field
(uffi:deref-array row '(:array (* :unsigned-char)) i)
types
(convert-raw-field
(uffi:deref-array row '(:array (* :unsigned-char)) i)
types
(defmethod database-list-tables ((database mysql-database) &key (owner nil))
(declare (ignore owner))
(defmethod database-list-tables ((database mysql-database) &key (owner nil))
(declare (ignore owner))
- (remove-if #'(lambda (s)
- (and (>= (length s) 11)
- (string-equal (subseq s 0 11) "_CLSQL_SEQ_")))
- (mapcar #'car (database-query "SHOW TABLES" database nil nil))))
-
-;; MySQL 4.1 does not support views
+ (cond
+ ((eql #\5 (char (database-server-info database) 0))
+ (loop for (name type) in (database-query "SHOW FULL TABLES" database nil nil)
+ when (and (string-equal type "base table")
+ (not (and (>= (length name) 11)
+ (string-equal (subseq name 0 11) "_CLSQL_SEQ_"))))
+ collect name))
+ (t
+ (remove-if #'(lambda (s)
+ (and (>= (length s) 11)
+ (string-equal (subseq s 0 11) "_CLSQL_SEQ_")))
+ (mapcar #'car (database-query "SHOW TABLES" database nil nil))))))
+
(defmethod database-list-views ((database mysql-database)
&key (owner nil))
(declare (ignore owner))
(defmethod database-list-views ((database mysql-database)
&key (owner nil))
(declare (ignore owner))
+ (cond
+ ((eql #\5 (char (database-server-info database) 0))
+ (loop for (name type) in (database-query "SHOW FULL TABLES" database nil nil)
+ when (string-equal type "view")
+ collect name))
+ (t
+ nil))))
(defmethod database-list-indexes ((database mysql-database)
&key (owner nil))
(defmethod database-list-indexes ((database mysql-database)
&key (owner nil))
&key (owner nil))
(declare (ignore owner))
(do ((results nil)
&key (owner nil))
(declare (ignore owner))
(do ((results nil)
(format nil "SHOW INDEX FROM ~A" (string-upcase table))
database nil nil)
(cdr rows)))
(format nil "SHOW INDEX FROM ~A" (string-upcase table))
database nil nil)
(cdr rows)))
(let ((col (nth 2 (car rows))))
(unless (find col results :test #'string-equal)
(push col results)))))
(let ((col (nth 2 (car rows))))
(unless (find col results :test #'string-equal)
(push col results)))))
(defmethod database-list-attributes ((table string) (database mysql-database)
&key (owner nil))
(declare (ignore owner))
(defmethod database-list-attributes ((table string) (database mysql-database)
&key (owner nil))
(declare (ignore owner))
(concatenate 'string "CREATE TABLE " table-name
" (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)")
database)
(concatenate 'string "CREATE TABLE " table-name
" (id int NOT NULL PRIMARY KEY AUTO_INCREMENT)")
database)
- (database-execute-command
+ (database-execute-command
(concatenate 'string "INSERT INTO " table-name
" VALUES (-1)")
database)))
(concatenate 'string "INSERT INTO " table-name
" VALUES (-1)")
database)))
(defmethod database-drop-sequence (sequence-name
(database mysql-database))
(database-execute-command
(defmethod database-drop-sequence (sequence-name
(database mysql-database))
(database-execute-command
- (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
+ (concatenate 'string "DROP TABLE " (%sequence-name-to-table sequence-name))
database))
(defmethod database-list-sequences ((database mysql-database)
database))
(defmethod database-list-sequences ((database mysql-database)
(defmethod database-sequence-next (sequence-name (database mysql-database))
(without-interrupts
(defmethod database-sequence-next (sequence-name (database mysql-database))
(without-interrupts
- (database-execute-command
+ (database-execute-command
(concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name)
" SET id=LAST_INSERT_ID(id+1)")
database)
(concatenate 'string "UPDATE " (%sequence-name-to-table sequence-name)
" SET id=LAST_INSERT_ID(id+1)")
database)
(defmethod database-sequence-last (sequence-name (database mysql-database))
(without-interrupts
(defmethod database-sequence-last (sequence-name (database mysql-database))
(without-interrupts
- (caar (database-query
- (concatenate 'string "SELECT id from "
+ (caar (database-query
+ (concatenate 'string "SELECT id from "
(%sequence-name-to-table sequence-name))
database :auto nil))))
(%sequence-name-to-table sequence-name))
database :auto nil))))
(destructuring-bind (host name user password &optional port) connection-spec
(multiple-value-bind (output status)
(clsql-sys:command-output "mysqladmin create -u~A -p~A -h~A~@[ -P~A~] ~A"
(destructuring-bind (host name user password &optional port) connection-spec
(multiple-value-bind (output status)
(clsql-sys:command-output "mysqladmin create -u~A -p~A -h~A~@[ -P~A~] ~A"
(if host host "localhost")
port name
name)
(if (or (not (eql 0 status))
(and (search "failed" output) (search "error" output)))
(error 'sql-database-error
(if host host "localhost")
port name
name)
(if (or (not (eql 0 status))
(and (search "failed" output) (search "error" output)))
(error 'sql-database-error
(format nil "mysql database creation failed with connection-spec ~A."
connection-spec))
t))))
(format nil "mysql database creation failed with connection-spec ~A."
connection-spec))
t))))
(destructuring-bind (host name user password &optional port) connection-spec
(multiple-value-bind (output status)
(clsql-sys:command-output "mysqladmin drop -f -u~A -p~A -h~A~@[ -P~A~] ~A"
(destructuring-bind (host name user password &optional port) connection-spec
(multiple-value-bind (output status)
(clsql-sys:command-output "mysqladmin drop -f -u~A -p~A -h~A~@[ -P~A~] ~A"
(if host host "localhost")
port name)
(if (or (not (eql 0 status))
(and (search "failed" output) (search "error" output)))
(error 'sql-database-error
(if host host "localhost")
port name)
(if (or (not (eql 0 status))
(and (search "failed" output) (search "error" output)))
(error 'sql-database-error
(format nil "mysql database deletion failed with connection-spec ~A."
connection-spec))
t))))
(format nil "mysql database deletion failed with connection-spec ~A."
connection-spec))
t))))
(length-ptr :initarg :length-ptr :reader length-ptr)
(is-null-ptr :initarg :is-null-ptr :reader is-null-ptr)
(result-types :initarg :result-types :reader result-types)))
(length-ptr :initarg :length-ptr :reader length-ptr)
(is-null-ptr :initarg :is-null-ptr :reader is-null-ptr)
(result-types :initarg :result-types :reader result-types)))
(defun clsql-type->mysql-type (type)
(cond
((in type :null) mysql-field-types#null)
(defun clsql-type->mysql-type (type)
(cond
((in type :null) mysql-field-types#null)
((and (consp type) (in (car type) :char :string :varchar)) mysql-field-types#var-string)
((or (eq type :blob) (and (consp type) (in (car type) :blob))) mysql-field-types#var-string)
(t
((and (consp type) (in (car type) :char :string :varchar)) mysql-field-types#var-string)
((or (eq type :blob) (and (consp type) (in (car type) :blob))) mysql-field-types#var-string)
(t
- (error 'sql-user-error
- :message
+ (error 'sql-user-error
+ :message
(format nil "Unknown clsql type ~A." type)))))
#+mysql-client-v4.1
(format nil "Unknown clsql type ~A." type)))))
#+mysql-client-v4.1
(error 'sql-database-error
:error-id (mysql-errno mysql-ptr)
:message (mysql-error-string mysql-ptr))))
(error 'sql-database-error
:error-id (mysql-errno mysql-ptr)
:message (mysql-error-string mysql-ptr))))
(unless (= (mysql-stmt-param-count stmt) (length types))
(mysql-stmt-close stmt)
(error 'sql-database-error
(unless (= (mysql-stmt-param-count stmt) (length types))
(mysql-stmt-close stmt)
(error 'sql-database-error
(format nil "Mysql param count (~D) does not match number of types (~D)"
(mysql-stmt-param-count stmt) (length types))))
(format nil "Mysql param count (~D) does not match number of types (~D)"
(mysql-stmt-param-count stmt) (length types))))
#+nil
(error 'sql-database-error
:message "mysql_stmt_result_metadata returned NULL"))
#+nil
(error 'sql-database-error
:message "mysql_stmt_result_metadata returned NULL"))
(let ((input-bind (uffi:allocate-foreign-object 'mysql-bind (length types)))
(mysql-types (mapcar 'clsql-type->mysql-type types))
field-vec num-fields is-null-ptr output-bind length-ptr)
(let ((input-bind (uffi:allocate-foreign-object 'mysql-bind (length types)))
(mysql-types (mapcar 'clsql-type->mysql-type types))
field-vec num-fields is-null-ptr output-bind length-ptr)
(print 'a)
(dotimes (i (length types))
(let* ((binding (uffi:deref-array input-bind '(:array mysql-bind) i)))
(print 'a)
(dotimes (i (length types))
(let* ((binding (uffi:deref-array input-bind '(:array mysql-bind) i)))
- (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-type)
+ (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-type)
- (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-length) 0)))
-
+ (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-length) 0)))
+
(print 'b)
(unless (uffi:null-pointer-p rs)
(setq field-vec (mysql-fetch-fields rs)
(print 'b)
(unless (uffi:null-pointer-p rs)
(setq field-vec (mysql-fetch-fields rs)
(type (uffi:get-slot-value field 'mysql-field 'type))
(binding (uffi:deref-array output-bind '(:array mysql-bind) i)))
(setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-type) type)
(type (uffi:get-slot-value field 'mysql-field 'type))
(binding (uffi:deref-array output-bind '(:array mysql-bind) i)))
(setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-type) type)
(setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-length) 0)
#+need-to-allocate-foreign-object-for-this
(setf (uffi:get-slot-value binding 'mysql-bind 'mysql::buffer-length) 0)
#+need-to-allocate-foreign-object-for-this
- (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::is-null)
+ (setf (uffi:get-slot-value binding 'mysql-bind 'mysql::is-null)
(+ i (uffi:pointer-address is-null-ptr)))
#+need-to-allocate-foreign-object-for-this
(+ i (uffi:pointer-address is-null-ptr)))
#+need-to-allocate-foreign-object-for-this
- (setf (uffi:get-slot-value binding 'mysql-bind 'length)
+ (setf (uffi:get-slot-value binding 'mysql-bind 'length)
(+ (* i 8) (uffi:pointer-address length-ptr)))
(+ (* i 8) (uffi:pointer-address length-ptr)))
(case type
((#.mysql-field-types#var-string #.mysql-field-types#string
#.mysql-field-types#tiny-blob #.mysql-field-types#blob
(case type
((#.mysql-field-types#var-string #.mysql-field-types#string
#.mysql-field-types#tiny-blob #.mysql-field-types#blob
(uffi:allocate-foreign-object 'mysql-time))
(t
(error "mysql type ~D not supported." type)))))
(uffi:allocate-foreign-object 'mysql-time))
(t
(error "mysql type ~D not supported." type)))))
(unless (zerop (mysql-stmt-bind-result stmt output-bind))
(mysql-stmt-close stmt)
(error 'sql-database-error
:error-id (mysql-stmt-errno stmt)
:message (uffi:convert-from-cstring
(mysql-stmt-error stmt)))))
(unless (zerop (mysql-stmt-bind-result stmt output-bind))
(mysql-stmt-close stmt)
(error 'sql-database-error
:error-id (mysql-stmt-errno stmt)
:message (uffi:convert-from-cstring
(mysql-stmt-error stmt)))))
(make-instance 'mysql-stmt
:database database
:stmt stmt
(make-instance 'mysql-stmt
:database database
:stmt stmt
(push
(loop for i from 0 below num-fields
collect
(push
(loop for i from 0 below num-fields
collect
(not (zerop (uffi:ensure-char-integer
(uffi:deref-array (is-null-ptr stmt) '(:array :byte) i))))))
(unless is-null
(not (zerop (uffi:ensure-char-integer
(uffi:deref-array (is-null-ptr stmt) '(:array :byte) i))))))
(unless is-null
(t
(list type)))))))
rows)))
(t
(list type)))))))
rows)))
#+mysql-client-v4.1
(defmethod database-free-prepared ((stmt mysql-stmt))
(with-slots (stmt) stmt
#+mysql-client-v4.1
(defmethod database-free-prepared ((stmt mysql-stmt))
(with-slots (stmt) stmt
t)
(defmethod db-type-has-views? ((db-type (eql :mysql)))
t)
(defmethod db-type-has-views? ((db-type (eql :mysql)))
- #+mysql-client-v5.1 t
- #-mysql-client-v5.1 nil)
+ #+mysql-client-v5 t
+ #-mysql-client-v5 nil)
(defmethod db-type-has-subqueries? ((db-type (eql :mysql)))
(defmethod db-type-has-subqueries? ((db-type (eql :mysql)))
- #+mysql-client-v4.1 t
- #-mysql-client-v4.1 nil)
+ #+(or mysql-client-v4.1 mysql-client-v5) t
+ #-(or mysql-client-v4.1 mysql-client-v5) nil)
(defmethod db-type-has-boolean-where? ((db-type (eql :mysql)))
(defmethod db-type-has-boolean-where? ((db-type (eql :mysql)))
- #+mysql-client-v4.1 t
- #-mysql-client-v4.1 nil)
+ #+(or mysql-client-v4.1 mysql-client-v5) t
+ #-(or mysql-client-v4.1 mysql-client-v5) nil)
(defmethod db-type-has-union? ((db-type (eql :mysql)))
(not (eql (schar mysql::*mysql-client-info* 0) #\3)))
(defmethod db-type-has-union? ((db-type (eql :mysql)))
(not (eql (schar mysql::*mysql-client-info* 0) #\3)))
(and tuple (string-equal "YES" (second tuple)))))
(defmethod db-type-has-prepared-stmt? ((db-type (eql :mysql)))
(and tuple (string-equal "YES" (second tuple)))))
(defmethod db-type-has-prepared-stmt? ((db-type (eql :mysql)))
- #+mysql-client-v4.1 t
- #-mysql-client-v4.1 nil)
+ #+(or mysql-client-v4.1 mysql-client-v5) t
+ #-(or mysql-client-v4.1 mysql-client-v5) nil)
(when (clsql-sys:database-type-library-loaded :mysql)
(clsql-sys:initialize-database-type :database-type :mysql))
(when (clsql-sys:database-type-library-loaded :mysql)
(clsql-sys:initialize-database-type :database-type :mysql))