Artful Code

(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)