Version 4.1.0

 * db-mysql/mysql-{sql,api}.lisp,db-mysql/clsql_mysql.c:
 Latest version of mysqlclient once again changed the C
 structures from which the mysql backend reads data.
 Rather than adding yet another structure definition which
 is enabled by the client version as read by mysql-client-info.lisp,
 the mysql backend has been re-written to ignore in the internal
 C structures. Instead, C wrapper functions for slot access have
 been added to clsql_mysql.c and are used by mysql-sql.lisp to
 access the internals of C structures. This adds a bit of overhead,
 but completely separates the lisp code from trying to keep up
 with the continually changing internal C structure of mysql.
 All tests in the test suite executed correctly with this change.

diff --git a/ChangeLog b/ChangeLog
index 3e6051dd96c19feb073861f5a5875eef54ea0683..3a5131875c1660b61e8ea68188d887d15e776a8a 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+31 Aug 2009  Kevin Rosenberg <kevin@rosenberg.net>
+       * Version 4.1.0
+       * db-mysql/mysql-{sql,api}.lisp,db-mysql/clsql_mysql.c:
+       Latest version of mysqlclient once again changed the C
+       structures from which the mysql backend reads data.
+       Rather than adding yet another structure definition which
+       is enabled by the client version as read by mysql-client-info.lisp,
+       the mysql backend has been re-written to ignore in the internal
+       C structures. Instead, C wrapper functions for slot access have
+       been added to clsql_mysql.c and are used by mysql-sql.lisp to
+       access the internals of C structures. This adds a bit of overhead,
+       but completely separates the lisp code from trying to keep up
+       with the continually changing internal C structure of mysql.
+       All tests in the test suite executed correctly with this change.
+
 31 Aug 2009  Kevin Rosenberg <kevin@rosenberg.net>
        * Version 4.0.6
        * sql/database.lisp: Fix syntax on process-lock (thanks to

diff --git a/db-mysql/clsql_mysql.c b/db-mysql/clsql_mysql.c
index 2d3b1282cbd5d65b2255e92dadbbd31ee09d2248..372ee0ab72aec5a16be807f86614498d073e8239 100644 (file)
--- a/db-mysql/clsql_mysql.c
+++ b/db-mysql/clsql_mysql.c
@@ -87,7 +87,15 @@ clsql_mysql_insert_id (MYSQL* mysql, unsigned int* pHigh32)
 /* Accessor functions to hide the differences across MySQL versions */
 
 DLLEXPORT
-short int
+unsigned int
+clsql_mysql_field_flags (MYSQL_FIELD* field)
+{
+  return field->flags;
+}
+
+
+DLLEXPORT
+unsigned int
 clsql_mysql_field_type (MYSQL_FIELD* field)
 {
   return field->type;
@@ -138,7 +146,6 @@ bind_param (MYSQL_BIND bind[], unsigned int n, unsigned long length, unsigned sh
 }
 
 
-DLLEXPORT
 DLLEXPORT
 unsigned int
 clsql_mysql_stmt_affected_rows (MYSQL_STMT* stmt, unsigned int* pHigh32)
@@ -148,6 +155,5 @@ clsql_mysql_stmt_affected_rows (MYSQL_STMT* stmt, unsigned int* pHigh32)
   return lower_32bits(nAffected);
 }
 
-
 #endif
 

diff --git a/db-mysql/mysql-api.lisp b/db-mysql/mysql-api.lisp
index 1f747f93c4e870d92522578e71925a96e63f702a..91fc3c5a6998807f31520f94bee61b0f7a2b8aea 100644 (file)
--- a/db-mysql/mysql-api.lisp
+++ b/db-mysql/mysql-api.lisp
@@ -39,44 +39,7 @@
      :socket
      :named-pipe))
 
-(uffi:def-struct mysql-net
-    (vio :pointer-void)
-  (fd mysql-socket)
-  (fcntl :int)
-  (buff (* :unsigned-char))
-  (buff-end (* :unsigned-char))
-  (write-pos (* :unsigned-char))
-  (read-pos (* :unsigned-char))
-  (last-error (:array :char 200))
-  (last-errno :unsigned-int)
-  (max-packet :unsigned-int)
-  (timeout :unsigned-int)
-  (pkt-nr :unsigned-int)
-  (error mysql-bool)
-  (return-errno mysql-bool)
-  (compress mysql-bool)
-  (no-send-ok mysql-bool)
-  (remain-in-buf :unsigned-long)
-  (length :unsigned-long)
-  (buf-length :unsigned-long)
-  (where-b :unsigned-long)
-  (return-status (* :unsigned-int))
-  (reading-or-writing :unsigned-char)
-  (save-char :char))
-
-;;; Mem-Root
-(uffi:def-struct mysql-used-mem
-    (next :pointer-self)
-  (left :unsigned-int)
-  (size :unsigned-int))
-
-(uffi:def-struct mysql-mem-root
-    (free (:struct-pointer mysql-used-mem))
-  (used (:struct-pointer mysql-used-mem))
-  (pre-alloc (:struct-pointer mysql-used-mem))
-  (min-alloc :unsigned-int)
-  (block-size :unsigned-int)
-  (error-handler :pointer-void))
+(uffi:def-array-pointer mysql-row (* :unsigned-char))
 
 ;;; MYSQL-FIELD
 (uffi:def-enum mysql-field-types
@@ -105,110 +68,6 @@
      (:string 254)
      (:geometry 255)))
 
-#+mysql-client-v3
-(uffi:def-struct mysql-field
-    (name (* :char))
-  (table (* :char))
-  (def (* :char))
-  (type mysql-field-types)
-  (length :unsigned-int)
-  (max-length :unsigned-int)
-  (flags :unsigned-int)
-  (decimals :unsigned-int))
-
-;; structure changed in mysql 4 client
-#+(and mysql-client-v4 (not mysql-client-v4.1))
-(uffi:def-struct mysql-field
-    (name (* :char))
-  (table (* :char))
-  (org_table (* :char))
-  (db (* :char))
-  (def (* :char))
-  (length :unsigned-long)
-  (max-length :unsigned-long)
-  (flags :unsigned-int)
-  (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))
-  (table (* :char))
-  (org_table (* :char))
-  (db (* :char))
-  (catalog_db (* :char))
-  (def (* :char))
-  (length :unsigned-long)
-  (max-length :unsigned-long)
-  (name-length :unsigned-int)
-  (org-name-length :unsigned-int)
-  (table-length :unsigned-int)
-  (org-table-length :unsigned-int)
-  (db-length :unsigned-int)
-  (catalog-length :unsigned-int)
-  (def-length :unsigned-int)
-  (flags :unsigned-int)
-  (decimals :unsigned-int)
-  (charsetnr :unsigned-int)
-  (type mysql-field-types))
-
-
-(uffi:def-struct mysql-time
-    (year :unsigned-int)
-  (month :unsigned-int)
-  (day :unsigned-int)
-  (hour :unsigned-int)
-  (minute :unsigned-int)
-  (second :unsigned-int)
-  (second-part :unsigned-long)
-  (neg mysql-bool)
-  (time-type :int))
-
-;;; MYSQL-ROWS
-
-(uffi:def-array-pointer mysql-row (* :unsigned-char))
-
-(uffi:def-array-pointer mysql-field-vector (* mysql-field))
-
-(uffi:def-foreign-type mysql-field-offset :unsigned-int)
-
-(uffi:def-struct mysql-rows
-    (next :pointer-self)
-  (data mysql-row))
-
-(uffi:def-foreign-type mysql-row-offset (:struct-pointer mysql-rows))
-
-(uffi:def-struct mysql-data
-    (rows-high32 :unsigned-long)
-  (rows-low32 :unsigned-long)
-  (fields :unsigned-int)
-  (data (:struct-pointer mysql-rows))
-  (alloc (:struct mysql-mem-root)))
-
-;;; MYSQL
-(uffi:def-struct mysql-options
-    (connect-timeout :unsigned-int)
-  (client-flag :unsigned-int)
-  (compress mysql-bool)
-  (named-pipe mysql-bool)
-  (port :unsigned-int)
-  (host (* :char))
-  (init-command (* :char))
-  (user (* :char))
-  (password (* :char))
-  (unix-socket (* :char))
-  (db (* :char))
-  (my-cnf-file (* :char))
-  (my-cnf-group (* :char))
-  (charset-dir (* :char))
-  (charset-name (* :char))
-  (use-ssl mysql-bool)
-  (ssl-key (* :char))
-  (ssl-cert (* :char))
-  (ssl-ca (* :char))
-  (ssl-capath (* :char)))
-
 (uffi:def-enum mysql-option
     (:connect-timeout
      :compress
@@ -222,96 +81,30 @@
      :get-result
      :use-result))
 
-(uffi:def-struct mysql-mysql
-    (net (:struct mysql-net))
-  (connected-fd (* :char))
-  (host (* :char))
-  (user (* :char))
-  (passwd (* :char))
-  (unix-socket (* :char))
-  (server-version (* :char))
-  (host-info (* :char))
-  (info (* :char))
-  (db (* :char))
-  (port :unsigned-int)
-  (client-flag :unsigned-int)
-  (server-capabilities :unsigned-int)
-  (protocol-version :unsigned-int)
-  (field-count :unsigned-int)
-  (server-status :unsigned-int)
-  (thread-id :unsigned-long)
-  (affected-rows-high32 :unsigned-long)
-  (affected-rows-low32 :unsigned-long)
-  (insert-id-high32 :unsigned-long)
-  (insert-id-low32 :unsigned-long)
-  (extra-info-high32 :unsigned-long)
-  (extra-info-low32 :unsigned-long)
-  (packet-length :unsigned-long)
-  (status mysql-status)
-  (fields (:struct-pointer mysql-field))
-  (field-alloc (:struct mysql-mem-root))
-  (free-me mysql-bool)
-  (reconnect mysql-bool)
-  (options (:struct mysql-options))
-  (scramble-buff (:array :char 9))
-  (charset :pointer-void)
-  (server-language :unsigned-int))
-
-
-;;; MYSQL-RES
-(uffi:def-struct mysql-mysql-res
-    (row-count-high32 :unsigned-long)
-  (row-count-low32 :unsigned-long)
-  (field-count :unsigned-int)
-  (current-field :unsigned-int)
-  (fields (:struct-pointer mysql-field))
-  (data (:struct-pointer mysql-data))
-  (data-cursor (:struct-pointer mysql-rows))
-  (field-alloc (:struct mysql-mem-root))
-  (row mysql-row)
-  (current-row mysql-row)
-  (lengths (* :unsigned-long))
-  (handle (:struct-pointer mysql-mysql))
-  (eof mysql-bool))
-
 #+(or mysql-client-v4.1 mysql-client-v5)
 (uffi:def-enum mysql-field-types
     (:ready
      :get-result
      :use-result))
 
-#+(or mysql-client-v4.1 mysql-client-v5)
-(uffi:def-struct mysql-bind
-    (length (* :unsigned-long))
-  (is-null (* mysql-bool))
-  (buffer :pointer-void)
-  (buffer-type :int)
-  (buffer-length :unsigned-long)
-  ;; internal use
-  (inter_buffer (* :unsigned-char))
-  (offset :unsigned-long)
-  (internal-length :unsigned-long)
-  (param-number :unsigned-int)
-  (pack-length :unsigned-int)
-  (is-signed mysql-bool)
-  (long-data-used mysql-bool)
-  (internal-is-null mysql-bool)
-  (store-param-func :pointer-void)
-  (fetch-result :pointer-void)
-  (skip-result :pointer-void))
+;;; Opaque pointers to mysql C-defined structures
+(uffi:def-foreign-type mysql-mysql (* :void))
+(uffi:def-foreign-type mysql-mysql-res (* :void))
+(uffi:def-foreign-type mysql-field (* :void))
+(uffi:def-foreign-type mysql-bind (* :void))
 
 ;;;; The Foreign C routines
 (declaim (inline mysql-init))
 (uffi:def-function "mysql_init"
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :module "mysql"
-  :returning (* mysql-mysql))
+  :returning mysql-mysql)
 
 ;; Need to comment this out for LW 4.2.6
 ;; ? bug in LW version
 #-lispworks (declaim (inline mysql-real-connect))
 (uffi:def-function "mysql_real_connect"
-    ((mysql (* mysql-mysql))
+    ((mysql mysql-mysql)
      (host :cstring)
      (user :cstring)
      (passwd :cstring)
@@ -320,24 +113,24 @@
      (unix-socket :cstring)
      (clientflag :unsigned-long))
   :module "mysql"
-  :returning (* mysql-mysql))
+  :returning mysql-mysql)
 
 (declaim (inline mysql-close))
 (uffi:def-function "mysql_close"
-    ((sock (* mysql-mysql)))
+    ((sock mysql-mysql))
   :module "mysql"
   :returning :void)
 
 (declaim (inline mysql-select-db))
 (uffi:def-function "mysql_select_db"
-  ((mysql (* mysql-mysql))
+  ((mysql mysql-mysql)
    (db :cstring))
   :module "mysql"
   :returning :int)
 
 (declaim (inline mysql-query))
 (uffi:def-function "mysql_query"
-    ((mysql (* mysql-mysql))
+    ((mysql mysql-mysql)
      (query :cstring))
   :module "mysql"
   :returning :int)
@@ -347,7 +140,7 @@
 
 (declaim (inline mysql-real-query))
 (uffi:def-function "mysql_real_query"
-    ((mysql (* mysql-mysql))
+    ((mysql mysql-mysql)
      (query :cstring)
      (length :unsigned-int))
   :module "mysql"
@@ -355,103 +148,103 @@
 
 (declaim (inline mysql-shutdown))
 (uffi:def-function "mysql_shutdown"
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :module "mysql"
   :returning :int)
 
 (declaim (inline mysql-dump-debug-info))
 (uffi:def-function "mysql_dump_debug_info"
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :module "mysql"
   :returning :int)
 
 (declaim (inline mysql-refresh))
 (uffi:def-function "mysql_refresh"
-  ((mysql (* mysql-mysql))
+  ((mysql mysql-mysql)
    (refresh-options :unsigned-int))
   :module "mysql"
   :returning :int)
 
 (declaim (inline mysql-kill))
 (uffi:def-function "mysql_kill"
-    ((mysql (* mysql-mysql))
+    ((mysql mysql-mysql)
      (pid :unsigned-long))
   :module "mysql"
   :returning :int)
 
 (declaim (inline mysql-ping))
 (uffi:def-function "mysql_ping"
-    ((mysql (* mysql-mysql)))
+    ((mysql mysql-mysql))
   :module "mysql"
   :returning :int)
 
 (declaim (inline mysql-stat))
 (uffi:def-function "mysql_stat"
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :module "mysql"
   :returning :cstring)
 
 (declaim (inline mysql-get-server-info))
 (uffi:def-function "mysql_get_server_info"
-    ((mysql (* mysql-mysql)))
+    ((mysql mysql-mysql))
   :module "mysql"
   :returning :cstring)
 
 (declaim (inline mysql-get-host-info))
 (uffi:def-function "mysql_get_host_info"
-    ((mysql (* mysql-mysql)))
+    ((mysql mysql-mysql))
   :module "mysql"
   :returning :cstring)
 
 (declaim (inline mysql-get-proto-info))
 (uffi:def-function "mysql_get_proto_info"
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :module "mysql"
   :returning :unsigned-int)
 
 (declaim (inline mysql-list-dbs))
 (uffi:def-function "mysql_list_dbs"
-  ((mysql (* mysql-mysql))
+  ((mysql mysql-mysql)
    (wild :cstring))
   :module "mysql"
-  :returning (* mysql-mysql-res))
+  :returning mysql-mysql-res)
 
 (declaim (inline mysql-list-tables))
 (uffi:def-function "mysql_list_tables"
-  ((mysql (* mysql-mysql))
+  ((mysql mysql-mysql)
    (wild :cstring))
   :module "mysql"
-  :returning (* mysql-mysql-res))
+  :returning mysql-mysql-res)
 
 (declaim (inline mysql-list-fields))
 (uffi:def-function "mysql_list_fields"
-  ((mysql (* mysql-mysql))
+  ((mysql mysql-mysql)
    (table :cstring)
    (wild :cstring))
   :module "mysql"
-  :returning (* mysql-mysql-res))
+  :returning mysql-mysql-res)
 
 (declaim (inline mysql-list-processes))
 (uffi:def-function "mysql_list_processes"
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :module "mysql"
-  :returning (* mysql-mysql-res))
+  :returning mysql-mysql-res)
 
 (declaim (inline mysql-store-result))
 (uffi:def-function "mysql_store_result"
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :module "mysql"
-  :returning (* mysql-mysql-res))
+  :returning mysql-mysql-res)
 
 (declaim (inline mysql-use-result))
 (uffi:def-function "mysql_use_result"
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :module "mysql"
-  :returning (* mysql-mysql-res))
+  :returning mysql-mysql-res)
 
 (declaim (inline mysql-options))
 (uffi:def-function "mysql_options"
-  ((mysql (* mysql-mysql))
+  ((mysql mysql-mysql)
    (option mysql-option)
    (arg :cstring))
   :module "mysql"
@@ -459,54 +252,47 @@
 
 (declaim (inline mysql-free-result))
 (uffi:def-function "mysql_free_result"
-    ((res (* mysql-mysql-res)))
+    ((res mysql-mysql-res))
   :module "mysql"
   :returning :void)
 
-(declaim (inline mysql-row-seek))
-(uffi:def-function "mysql_row_seek"
-  ((res (* mysql-mysql-res))
-   (offset mysql-row-offset))
-  :module "mysql"
-  :returning mysql-row-offset)
-
-(declaim (inline mysql-field-seek))
-(uffi:def-function "mysql_field_seek"
-  ((res (* mysql-mysql-res))
-  (offset mysql-field-offset))
-  :module "mysql"
-  :returning mysql-field-offset)
-
 (declaim (inline mysql-fetch-row))
 (uffi:def-function "mysql_fetch_row"
-    ((res (* mysql-mysql-res)))
+    ((res mysql-mysql-res))
   :module "mysql"
   :returning (* (* :unsigned-char)))
 
 (declaim (inline mysql-fetch-lengths))
 (uffi:def-function "mysql_fetch_lengths"
-  ((res (* mysql-mysql-res)))
+  ((res mysql-mysql-res))
   :module "mysql"
   :returning (* :unsigned-long))
 
 (declaim (inline mysql-fetch-field))
 (uffi:def-function "mysql_fetch_field"
-  ((res (* mysql-mysql-res)))
+  ((res mysql-mysql-res))
   :module "mysql"
-  :returning (* mysql-field))
+  :returning mysql-field)
+
+(declaim (inline mysql-field-seek))
+(uffi:def-function "mysql_field_seek"
+  ((res mysql-mysql-res)
+   (offset :unsigned-int))
+  :module "mysql"
+  :returning :unsigned-int)
 
 (declaim (inline mysql-fetch-fields))
 (uffi:def-function "mysql_fetch_fields"
-  ((res (* mysql-mysql-res)))
+  ((res mysql-mysql-res))
   :module "mysql"
-  :returning (* mysql-field))
+  :returning mysql-field)
 
 (declaim (inline mysql-fetch-field-direct))
 (uffi:def-function "mysql_fetch_field_direct"
-  ((res (* mysql-mysql-res))
+  ((res mysql-mysql-res)
    (field-num :unsigned-int))
   :module "mysql"
-  :returning (* mysql-field))
+  :returning mysql-field)
 
 (declaim (inline mysql-escape-string))
 (uffi:def-function "mysql_escape_string"
@@ -524,7 +310,7 @@
 
 (declaim (inline clsql-mysql-num-rows))
 (uffi:def-function "clsql_mysql_num_rows"
-    ((res (* mysql-mysql-res))
+    ((res mysql-mysql-res)
      (p-high32 (* :unsigned-int)))
   :module "clsql-mysql"
   :returning :unsigned-int)
@@ -534,7 +320,7 @@
 
 #+(or mysql-client-v4.1 mysql-client-v5)
 (uffi:def-function "mysql_stmt_init"
-    ((res (* mysql-mysql-res)))
+    ((res mysql-mysql-res))
   :module "clsql-mysql"
   :returning mysql-stmt-ptr)
 
@@ -555,14 +341,14 @@
 #+(or mysql-client-v4.1 mysql-client-v5)
 (uffi:def-function "mysql_stmt_bind_param"
     ((stmt mysql-stmt-ptr)
-     (bind (* mysql-bind)))
+     (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)))
+     (bind mysql-bind))
   :module "clsql-mysql"
   :returning :short)
 
@@ -570,7 +356,7 @@
 (uffi:def-function "mysql_stmt_result_metadata"
     ((stmt mysql-stmt-ptr))
   :module "clsql-mysql"
-  :returning (* mysql-mysql-res))
+  :returning mysql-mysql-res)
 
 
 #+(or mysql-client-v4.1 mysql-client-v5)
@@ -630,7 +416,7 @@
         (make-64-bit-integer high32 low32)))))
 
 (uffi:def-function "clsql_mysql_affected_rows"
-    ((mysql (* mysql-mysql))
+    ((mysql mysql-mysql)
      (p-high32 (* :unsigned-int)))
   :returning :unsigned-int
   :module "clsql-mysql")
@@ -644,7 +430,7 @@
         (make-64-bit-integer high32 low32)))))
 
 (uffi:def-function "clsql_mysql_insert_id"
-    ((res (* mysql-mysql))
+    ((res mysql-mysql)
      (p-high32 (* :unsigned-int)))
   :returning :unsigned-int
   :module "clsql-mysql")
@@ -660,13 +446,13 @@
 
 (declaim (inline mysql-num-fields))
 (uffi:def-function "mysql_num_fields"
-  ((res (* mysql-mysql-res)))
+  ((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)))
+  ((res mysql-mysql-res))
   :returning :char
   :module "mysql")
 
@@ -678,7 +464,7 @@
 
 (declaim (inline mysql-error))
 (uffi:def-function ("mysql_error" mysql-error)
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :returning :cstring
   :module "mysql")
 
@@ -688,13 +474,13 @@
 
 (declaim (inline mysql-errno))
 (uffi:def-function "mysql_errno"
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :returning :unsigned-int
   :module "mysql")
 
 (declaim (inline mysql-info))
 (uffi:def-function ("mysql_info" mysql-info)
-  ((mysql (* mysql-mysql)))
+  ((mysql mysql-mysql))
   :returning :cstring
   :module "mysql")
 
@@ -704,12 +490,30 @@
 
 (declaim (inline clsql-mysql-data-seek))
 (uffi:def-function "clsql_mysql_data_seek"
-  ((res (* mysql-mysql-res))
+  ((res mysql-mysql-res)
    (offset-high32 :unsigned-int)
    (offset-low32 :unsigned-int))
   :module "clsql-mysql"
   :returning :void)
 
+(declaim (inline clsql-mysql-field-name))
+(uffi:def-function "clsql_mysql_field_name"
+  ((res mysql-field))
+  :module "clsql-mysql"
+  :returning :cstring)
+
+(declaim (inline clsql-mysql-field-flags))
+(uffi:def-function "clsql_mysql_field_flags"
+  ((res mysql-field))
+  :module "clsql-mysql"
+  :returning :unsigned-int)
+
+(declaim (inline clsql-mysql-field-type))
+(uffi:def-function "clsql_mysql_field_type"
+  ((res mysql-field))
+  :module "clsql-mysql"
+  :returning :unsigned-int)
+
 (defun mysql-data-seek (res offset)
   (multiple-value-bind (high32 low32) (split-64-bit-integer offset)
     (clsql-mysql-data-seek res high32 low32)))

diff --git a/db-mysql/mysql-package.lisp b/db-mysql/mysql-package.lisp
index 58b04ce4192e150cb285c9825545658dd0e5e166..53f13893cc4f0adec5adde708c0e82c684851860 100644 (file)
--- a/db-mysql/mysql-package.lisp
+++ b/db-mysql/mysql-package.lisp
@@ -145,5 +145,8 @@
      #:mysql-stmt-error
 
      #:make-64-bit-integer
+     #:clsql-mysql-field-name
+     #:clsql-mysql-field-type
+     #:clsql-mysql-field-flags
      )
     (:documentation "This is the low-level interface MySQL."))

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index 7c332cf5f7c8a03d0adfb01f18f1d1e505813e8b..8f39471257c2a38ee6feaeea0faf371ecc48ca09 100644 (file)
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -6,7 +6,7 @@
 ;;;; Purpose:       High-level MySQL interface using UFFI
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id$
+;;;; This file, part of CLSQL, is Copyright (c) 2002-2009 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
@@ -28,56 +28,52 @@
 
 ;;; Field conversion functions
 
-(defun result-field-names (num-fields res-ptr)
-  (declare (fixnum num-fields))
-  (let ((names '())
-        (field-vec (mysql-fetch-fields res-ptr)))
-    (dotimes (i num-fields)
-      (declare (fixnum i))
-      (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
-             (name (uffi:convert-from-foreign-string
-                    (uffi:get-slot-value field 'mysql-field 'mysql::name))))
-        (push name names)))
+(defun result-field-names (res-ptr)
+  (let ((names '()))
+    (mysql-field-seek res-ptr 0)
+    (loop
+       (let ((field (mysql-fetch-field res-ptr)))
+         (when (uffi:null-pointer-p field) (return))
+         (push (uffi:convert-from-cstring (clsql-mysql-field-name field)) names)))
     (nreverse names)))
 
-(defun make-type-list-for-auto (num-fields res-ptr)
-  (declare (fixnum num-fields))
-  (let ((new-types '())
-        (field-vec (mysql-fetch-fields res-ptr)))
-    (dotimes (i num-fields)
-      (declare (fixnum i))
-      (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
-             (flags (uffi:get-slot-value field 'mysql-field 'mysql::flags))
-             (unsigned (plusp (logand flags 32)))
-             (type (uffi:get-slot-value field 'mysql-field 'type)))
-        (push
-         (case type
-           ((#.mysql-field-types#tiny
-             #.mysql-field-types#short
-             #.mysql-field-types#int24)
-            (if unsigned
-                :uint32
-              :int32))
-           (#.mysql-field-types#long
-            (if unsigned
-                :uint
-              :int))
-            (#.mysql-field-types#longlong
-             (if unsigned
-                 :uint64
-               :int64))
-           ((#.mysql-field-types#double
-             #.mysql-field-types#float
-             #.mysql-field-types#decimal)
-            :double)
-           (otherwise
-            t))
-         new-types)))
+(defun make-type-list-for-auto (res-ptr)
+  (let ((new-types '()))
+    (mysql-field-seek res-ptr 0)
+    (loop
+       (let ((field (mysql-fetch-field res-ptr)))
+         (when (uffi:null-pointer-p field) (return))
+         (let* ((flags (clsql-mysql-field-flags field))
+                (unsigned (plusp (logand flags 32)))
+                (type (clsql-mysql-field-type field)))
+           (push
+            (case type
+              ((#.mysql-field-types#tiny
+                #.mysql-field-types#short
+                #.mysql-field-types#int24)
+               (if unsigned
+                   :uint32
+                   :int32))
+              (#.mysql-field-types#long
+               (if unsigned
+                   :uint
+                   :int))
+              (#.mysql-field-types#longlong
+               (if unsigned
+                   :uint64
+                   :int64))
+              ((#.mysql-field-types#double
+                #.mysql-field-types#float
+                #.mysql-field-types#decimal)
+               :double)
+              (otherwise
+               t))
+            new-types))))
     (nreverse new-types)))
 
-(defun canonicalize-types (types num-fields res-ptr)
+(defun canonicalize-types (types res-ptr)
   (when types
-    (let ((auto-list (make-type-list-for-auto num-fields res-ptr)))
+    (let ((auto-list (make-type-list-for-auto res-ptr)))
       (cond
         ((listp types)
          (canonicalize-type-list types auto-list))
@@ -89,9 +85,11 @@
 (defmethod database-initialize-database-type ((database-type (eql :mysql)))
   t)
 
-(uffi:def-type mysql-mysql-ptr-def (* mysql-mysql))
+;;(uffi:def-type mysql-mysql-ptr-def (* mysql-mysql))
+;;(uffi:def-type mysql-mysql-res-ptr-def (* mysql-mysql-res))
+(uffi:def-type mysql-mysql-ptr-def mysql-mysql)
+(uffi:def-type mysql-mysql-res-ptr-def mysql-mysql-res)
 (uffi:def-type mysql-row-def mysql-row)
-(uffi:def-type mysql-mysql-res-ptr-def (* mysql-mysql-res))
 
 (defclass mysql-database (database)
   ((mysql-ptr :accessor database-mysql-ptr :initarg :mysql-ptr
@@ -194,8 +192,7 @@
                      (let ((num-fields (mysql-num-fields res-ptr)))
                        (declare (fixnum num-fields))
                        (setq result-types (canonicalize-types
-                                    result-types num-fields
-                                    res-ptr))
+                                    result-types res-ptr))
                        (values
                         (loop for row = (mysql-fetch-row res-ptr)
                               for lengths = (mysql-fetch-lengths res-ptr)
@@ -215,7 +212,7 @@
                                        (uffi:deref-array lengths '(:array :unsigned-long)
                                                          i)))))
                         (when field-names
-                          (result-field-names num-fields res-ptr))))
+                          (result-field-names res-ptr))))
                   (mysql-free-result res-ptr))
                 (error 'sql-database-data-error
                        :database database
@@ -269,8 +266,7 @@
                                     :full-set full-set
                                     :types
                                     (canonicalize-types
-                                     result-types num-fields
-                                     res-ptr))))
+                                     result-types res-ptr))))
                   (if full-set
                       (values result-set
                               num-fields
@@ -767,4 +763,3 @@
 
 (when (clsql-sys:database-type-library-loaded :mysql)
   (clsql-sys:initialize-database-type :database-type :mysql))
-

diff --git a/debian/changelog b/debian/changelog
index b7950eb5fdc00d0a7a201cd6adaab52b51d6277a..07ea4a8fc33e40247cfd94f4802b4d67bd263272 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-sql (4.1.0-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon, 31 Aug 2009 22:43:56 -0600
+
 cl-sql (4.0.6-1) unstable; urgency=low
 
   * New upstream