It has been a very busy few weeks here. This is the time of year when work gets very rushed, and on top of that, my wife and I are expecting. Due to all of that, I have decided against finishing the C Libraries tutorial for newLisp at this time. The reason that I had worked on it to begin with was to attempt a better MySQL module than the current mysql5.lsp module that comes with the newLisp distribution, but due to time constraints, I have instead written some alterations to the current one that provide many of the same features that I was looking for initially, and fixing a few of the more superficial and crucial problems that I found in the library (in particular, fetch-all's habit of leaving around old result sets without clearing the data by using a context-global variable for storage, rather than a local variable).

New features in this version of the module:

• Fixed fetch-all to use a local variable to prevent alteration of future result sets
• num-fields: returns the number of columns in the result set
• result-fields: returns a list of columns' field-names for the current result set
• fetch-table: maps the column field names to the row data
• add-path: adds a path to an internal list of paths that init will search for the mysql client library
• Added several default paths:
  • /usr/lib/libmysqlclient.so
  • /usr/local/mysql/lib/libmysqlclient.dylib
  • C:\mysql\lib\mysqlclient.dll

Caveats:

• Broke documentation module by using lisp-style function documentation (inline docs and comments) and deleting Lutz's documentation for my own fiendish reasons (I can see more code while I'm working on the source). If I get around to making my changes more professional, I will restore the documentation for the module.
• fetch-table is perhaps not quite as optimized as it could be; as it is, it takes nearly twice the time to create the results list as a normal fetch-all operation

I will also make this available on its own page on the site. Now, without further ado:

(context 'MySQL)

; following constant offsets into 'C' data structures are different on each
; major MySQL version compile and run util/sql.c from the distribution to
; obtain these numbers

; check endianess of the host CPU 
(set 'big-endian (= (pack ">ld" 1) (pack "ld" 1)))

(constant 'NUM_ROWS_OFFSET (if big-endian 4 0))
(constant 'NUM_FIELDS_OFFSET 60)
(constant 'ERROR_OFFSET 85)
(constant 'INSERT_ID_OFFSET (if big-endian 708 704))
(constant 'AFFECTED_ROWS_OFFSET (if big-endian 700 696))

(define (init)
  (set 'MYSQL (mysql_init 0))
  (if (= MYSQL 0) (set 'MYSQL nil))
  (not (= MYSQL nil)))

(define (connect host user passw database)
  (not(= (mysql_real_connect MYSQL host user passw database 0 0 0) 0)))

(define (MySQL:query sql)
  (if MYSQL_RES (mysql_free_result MYSQL_RES))
  (set 'result  (= (mysql_query MYSQL sql) 0))
  (set 'MYSQL_RES (mysql_store_result MYSQL)) 
  (if (= MYSQL_RES 0) (set 'MYSQL_RES nil))
  (if (and result (find "insert into" sql 1)) (set 'result (inserted-id)))
  result)

(define (num-rows)
  (if MYSQL_RES (get-int (int (+ MYSQL_RES NUM_ROWS_OFFSET)))))

(define (num-fields)
  (if MYSQL_RES (get-int (int (+ MYSQL_RES NUM_FIELDS_OFFSET)))))

(define (keep-type res_ptr field_addr column_num, data)
  (set 'type_ptr (mysql_fetch_field_direct res_ptr (int column_num)))
  ; The field type is the 20th field of the MySQL_FIELD structure
  ; since fields 1-19 are all 4 byte fields we get the enum value
  ; like so
  (set 'data (get-int (int (+ type_ptr (* 19 4)))))
  ; Consult 'enum_field_types' in mysql_com.h for values
  (if (= data 1) ;; boolean
        (get-string field_addr)
      (= data 3) ;; integer
        (int (get-string field_addr))
      (= data 12) ;; datetime
        (apply date-value (map int (parse (get-string field_addr) "[-: ]" 0)))
      (= data 4) ;; float
        (float (get-string field_addr))
      ; else (will handle TEXT type 252)
      (get-string field_addr)
  )
)

(define (fetch-row)
  (if MYSQL_RES
    (set 'rdata (mysql_fetch_row MYSQL_RES))
    (set 'rdata 0))
  (if (!= rdata 0)
    (begin
      (set 'row '())
      (dotimes (field (num-fields))
            (set 'field_addr (get-int (int (+ rdata (* field 4)))))
            (if (= field_addr 0)
              (push nil row -1) ;; what to do when the field contains NULL
              (push (keep-type MYSQL_RES field_addr field) row -1)))
    row)))

(define (fetch-all)
  (dotimes (x (num-rows)) (push (fetch-row) all))
  (reverse all))

(define (databases)
  (query "show databases;")
  (fetch-all))

(define (tables)
  (query "show tables;")
  (fetch-all))

(define (fields table)
  (query (append "show fields from " table ";"))
  (fetch-all))
 
(define (data-seek offset)
  (if MYSQL_RES
    (if big-endian
    	(mysql_data_seek MYSQL_RES  0 (int offset))
        (mysql_data_seek MYSQL_RES (int offset) 0)))
  true
)

(define (error)
  (if MYSQL (get-string (+ MYSQL ERROR_OFFSET))))

(define (affected-rows)
  (if MYSQL
    (get-int (int (+ MYSQL AFFECTED_ROWS_OFFSET)))))

(define (inserted-id)
  (if MYSQL (get-int (int (+ MYSQL INSERT_ID_OFFSET)))))

(define (escape value , safe-value) 
  (set 'safe-value (dup " " (+ 1 (length value)))) 
  (MySQL:mysql_real_escape_string MySQL:MYSQL safe-value value (length value)) 
  safe-value)

(define (close-db)
  (if MYSQL_RES (mysql_free_result MYSQL_RES))
  (if MYSQL (mysql_close MYSQL))
  (set 'MYSQL nil)
  (set 'MYSQL_RES nil)
  true)

;;; My additions

(set 'lib-paths '("/usr/lib/libmysqlclient.so" ; linux
                  "/usr/local/mysql/lib/libmysqlclient.dylib" ; osx
                  "C:\\mysql\\lib\\mysqlclient.dll")) ; win32

(define (add-path str-path)
  "Pushes new path on to lib-paths, our list of paths to search for the
  mysql client library."
  (push str-path lib-paths))

(define (init)
  "Attempts to initialize the module."
  ;; New init actions
  (dolist (lib lib-paths) (if (file? lib) (set 'libmysqlclient lib)))
  (import libmysqlclient "mysql_init")
  (import libmysqlclient "mysql_real_connect")
  (import libmysqlclient "mysql_get_host_info")
  (import libmysqlclient "mysql_real_escape_string")
  (import libmysqlclient "mysql_query")
  (import libmysqlclient "mysql_real_query")
  (import libmysqlclient "mysql_store_result")
  (import libmysqlclient "mysql_free_result")
  (import libmysqlclient "mysql_data_seek")
  (import libmysqlclient "mysql_fetch_row")
  (import libmysqlclient "mysql_close")
  (import libmysqlclient "mysql_fetch_field_direct")
  (import libmysqlclient "mysql_insert_id")
  (import libmysqlclient "mysql_num_fields")
  (import libmysqlclient "mysql_fetch_field")
  ;; Perform previous definition's actions
  (set 'MYSQL (mysql_init 0))
  (if (= MYSQL 0) (set 'MYSQL nil))
  (not (= MYSQL nil)))

(define (fetch-all , all)
  "Redefined fetch-all that is not affected by previous results, nor does it
  affect future results."
  (dotimes (x (num-rows)) (push (fetch-row) all))
  (reverse all))

(define (num-fields)
  "Evaluates the total number of fields for the current result."
  (mysql_num_fields MYSQL_RES))

(define (result-fields)
  "Generates a list of strings reflecting the names of the fields in the
  current result."
  (let ((fields '()))
       (dotimes (i (num-fields))
         (push (get-string (get-int (mysql_fetch_field MYSQL_RES)))
               fields -1)) fields))

(define (fetch-table)
  "Creates a table associating field names with field values for the current
  result.  This will not work if the result has already been pulled another
  way."
  (letn ((rows (fetch-all)) (fields (result-fields))
         (pair (lambda (row) (map list fields row))))
        (map pair rows)))

(context 'MAIN)