X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-mysql%2Fmysql-sql.lisp;h=afadd6c63c77e683c71fb204e47920c8a0fe508e;hb=5dfea0c629f967d7ace700b63adf62eb11f88d9b;hp=eaea5d2aa8f004be9861ef6a714b404d0221ed78;hpb=81d2ebcdd182dd674191b29e00274c82660fd3f3;p=clsql.git diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index eaea5d2..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.6 2003/06/23 19:25:30 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) @@ -148,7 +148,8 @@ (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)) + (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 @@ -158,6 +159,7 @@ 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)) @@ -170,7 +172,9 @@ (uffi:deref-array row '(:array (* :unsigned-char)) i) - types i))))) + types i + (uffi:deref-array lengths '(:array :unsigned-long) + i)))))) (mysql-free-result res-ptr)) (error 'clsql-sql-error :database database @@ -224,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 @@ -246,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)))) @@ -286,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)) @@ -297,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))