X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-mysql%2Fmysql-sql.lisp;h=afadd6c63c77e683c71fb204e47920c8a0fe508e;hb=5dfea0c629f967d7ace700b63adf62eb11f88d9b;hp=fee81b5c7822272ce81115ae8b147b13abb604df;hpb=20e845656e846b8f48c6243c9ef7211a434a034f;p=clsql.git diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index fee81b5..afadd6c 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -2,13 +2,13 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: mysql-sql.cl +;;;; Name: mysql-sql.lisp ;;;; Purpose: High-level MySQL interface using UFFI ;;;; Programmers: Kevin M. Rosenberg based on ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: mysql-sql.lisp,v 1.5 2003/06/08 12:48:55 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -43,6 +43,7 @@ ;;; Field conversion functions (defun make-type-list-for-auto (num-fields res-ptr) + (declare (fixnum num-fields)) (let ((new-types '()) #+ignore (field-vec (mysql-fetch-fields res-ptr))) (dotimes (i num-fields) @@ -69,16 +70,15 @@ (nreverse new-types))) (defun canonicalize-types (types num-fields res-ptr) - (if (null types) - nil - (let ((auto-list (make-type-list-for-auto num-fields res-ptr))) - (cond - ((listp types) - (canonicalize-type-list types auto-list)) - ((eq types :auto) - auto-list) - (t - nil))))) + (when types + (let ((auto-list (make-type-list-for-auto num-fields res-ptr))) + (cond + ((listp types) + (canonicalize-type-list types auto-list)) + ((eq types :auto) + auto-list) + (t + nil))))) (defmethod database-initialize-database-type ((database-type (eql :mysql))) t) @@ -143,6 +143,51 @@ t) +(defmethod database-query (query-expression (database mysql-database) + types) + (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 + (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 types (canonicalize-types + types num-fields + res-ptr)) + (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) + types i + (uffi:deref-array lengths '(:array :unsigned-long) + i)))))) + (mysql-free-result res-ptr)) + (error 'clsql-sql-error + :database database + :expression query-expression + :errno (mysql-errno mysql-ptr) + :error (mysql-error-string mysql-ptr)))) + (error 'clsql-sql-error + :database database + :expression query-expression + :errno (mysql-errno mysql-ptr) + :error (mysql-error-string mysql-ptr)))))) + +#+ignore (defmethod database-query (query-expression (database mysql-database) types) (declare (optimize (speed 3) (safety 0) (debug 0) (space 0))) @@ -183,7 +228,8 @@ (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-query mysql-ptr sql-native)) + (if (zerop (mysql-real-query mysql-ptr sql-native + (length sql-expression))) t (error 'clsql-sql-error :database database @@ -205,7 +251,8 @@ (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-query mysql-ptr query-native)) + (if (zerop (mysql-real-query mysql-ptr query-native + (length query-expression))) (let ((res-ptr (if full-set (mysql-store-result mysql-ptr) (mysql-use-result mysql-ptr)))) @@ -245,6 +292,7 @@ (defmethod database-store-next-row (result-set (database mysql-database) list) (let* ((res-ptr (mysql-result-set-res-ptr result-set)) (row (mysql-fetch-row res-ptr)) + (lengths (mysql-fetch-lengths res-ptr)) (types (mysql-result-set-types result-set))) (declare (type mysql-mysql-res-ptr-def res-ptr) (type mysql-row-def row)) @@ -256,10 +304,10 @@ (convert-raw-field (uffi:deref-array row '(:array (* :unsigned-char)) i) types - i))) + i + (uffi:deref-array lengths :unsigned-long i)))) list))) (when (clsql-base-sys:database-type-library-loaded :mysql) - (clsql-base-sys:initialize-database-type :database-type :mysql) - (pushnew :mysql cl:*features*)) + (clsql-base-sys:initialize-database-type :database-type :mysql))