X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-mysql%2Fmysql-sql.lisp;h=0078d488aa703ab70bd3d8c294590c54cee53b03;hb=8d2b56a0133193db4675e172a344052c54dadcd2;hp=fee81b5c7822272ce81115ae8b147b13abb604df;hpb=20e845656e846b8f48c6243c9ef7211a434a034f;p=clsql.git diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index fee81b5..0078d48 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -8,7 +8,7 @@ ;;;; 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: mysql-sql.lisp,v 1.7 2003/06/24 01:12:57 kevin Exp $ ;;;; ;;;; 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,47 @@ 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-query mysql-ptr query-native)) + (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) + 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))))) + (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)))