#|                                                              -*- Scheme -*- 
   Copyright (c) 2003 David Van Horn
   Licensed under the Academic Free License version 2.0

   MySQL Client Library
   dvanhorn@cs.uvm.edu

   The mysqlclient library allows Scheme programs to access a MySQL database.
   This API provides a straight-forward mapping of the MySQL C API
   <http://www.mysql.com/doc/en/C.html> into the Scheme language.

 USE:

     Simply place this file in some collections path and compile.  Add
     (require (lib "mysqlclient.ss" "collection")) to any programs that wish
     to use a MySQL database.

 PREREQUISITES:

     You must have the MySQL Client library and header files at compile
     time, and these files should be in your include path when compiling.

     To compile: (change paths appropriately)

        cd collection
        mzc --auto-dir ++ldf /usr/lib/libmysqlclient.so.10 \
                       ++ccf -I/usr/include/mysql/

     This library must be compiled before using.  Failure to compile prior
     to requiring this library will result in an exception.

     Currently this library requires the c-syntax module to define some
     helper syntax for FFI short-hand notations.  In the future, dependence
     on this syntax should be removed; it's merely a convenience for
     development of this library.

 PORTING:

     This library is currently only known to work with PLT Scheme.  However,
     this library is built using a subset of Gambit-C's foreign-function
     interface (see Marc Feeley's Gambit-C, version 3.0).  So any Scheme
     that supports this subset should be an easy target for porting this
     library.  This library uses the PLT module system which would need to
     be changed in any port.

 ALTERNATIVES:

     MzScheme and Guile are supported languages of SWIG, which can easily
     generate a wrapper interface for the mysqlclient library.  In fact,
     Schematics <http://schematics.sourceforge.net/> have done just that for
     MzScheme.

     Many Schemes provide some mechanism for linking to C libraries.  Read
     the documentation for your Scheme of choice.

     For an OCaml approach to this same problem, see
     <http://raevnos.pennmush.org/code/mysql/index.html>.

 GOALS:

     The primary goal of this module is to be faithful to the C library.  It
     provides a one-to-one mapping for all the C API functions and
     structures (well, not structures yet).  In the C API many functions
     return zero for success.  Non-zero if an error occurred.  In this API,
     procedures return #f for success, in keeping with the C semantics.  So
     that, for example

                  if (!mysql_real_connect(&mysql ...)) {
                     ... mysql_error(&mysql) ... }
     Becomes:
                  (if (not (real-connect mysql ...))
                      ... (mysql-error mysql) ...)


 PROBLEM:
 
     One problem is that this library is very sensitive to the MySQL header
     files.  When I first developed this file, it was for a very recent
     version of MySQL.  Then using it a UVM, the version much older.  Many
     of the bindings failed because there was no C counter part in the older
     version of the header.  I don't really have ideas on how to fix this.
     I used to explicity define all the enums, including all the error codes
     and such.  I don't think this is really useful for the Scheme
     programmer to have and it was a source of a lot of changes between
     versions of MySQL, and hence where many of the compilation errors were
     spawning from for this file.  I've thought about perhaps interfacing
     only to a minimal set of MySQL functionality.  A set that would be less
     likely to change.  But it would have to require enough to be flexible
     and expressive.  This is the approach taken in this module.

     Of course a very sensible alternative to my approach is to use a tool
     like SWIG to generate all these bindings.  With that approach, changing
     versions will not cause problems, you would just run swig again to
     regenate a new a total set of bindings for the API.  We are constrained
     in that we can't install SWIG, or at least, it seems like a heavy
     handed approach to getting MySQL functionality in MzScheme since there
     is a very nice FFI provided.

     Another advantage of this approach over using SWIG is compatibility
     with other Schemes.  Any Scheme that supports a simple subset of the
     Gambit-C FFI (as MzScheme does) should be able to use this module (with
     some modifications, cf. Porting).  Swig, on the other hand only
     supports Guile and MzScheme.

 TODO:

     This library needs some good use.  It has little to no mileage
     currently.  It needs test cases.  Many of these procedures have never
     been called!  User documentation.  Figure out what to do about C
     structures in Scheme.

     .plt Package.

     Documentation.

 HIGHER LEVEL INTERFACE:

     A higher level interface utilizing this library could be helpful.  Some
     ideas are:

       * Throw exceptions on failure and return meaningful values.
       * Do some bounds checking on array access in row-ref.
       * Rename `real-connect' `connect' and so on.
       * Change the return #f on success convention.
       * Rows as vectors.
       * Result sets as lazy lists.
       * C structs as Scheme structures.

 NAMING CONVENTION:

     The Scheme procedure counterpart to each C function is named by
     dropping the `mysql' prefix and using a dash character instead of an
     underscore.  The only exception to this rule is the procedure
     `mysql-error'.  This is done to avoid confusion with the primitive
     Scheme `error' procedure.


 DIVERGENCE:

     The Scheme API diverges from the C API in the following ways:

       * options
       * not full coverage of C API, especially MySQL stucts
|#

(module mysqlclient mzscheme
  (require "c-syntax.ss")
  (provide (all-defined))

  ;; The MySQL Client library header files.
  ;; NB: Need appropriate path for include directory when compiling.
  (c-declare "#include <mysql.h>")
  (c-declare "#include <errmsg.h>")
  (c-declare "#include <mysqld_error.h>")

                                        ; should be my_ulonglong
  (define affected-rows
    (c-lambda ((pointer "MYSQL")) unsigned-long
              "mysql_affected_rows"))

 
                                        ; returns #f on sucess.

  (define change-user
    (c-lambda ((pointer "MYSQL") char-string char-string char-string) bool
              "mysql_change_user"))
  
  (define character-set-name
    (c-lambda ((pointer "MYSQL")) nonnull-char-string
              "mysql_character_set_name"))

  (define close
    (c-lambda ((pointer "MYSQL")) void
              "mysql_close"))

                                        ; `connect' is deprecated in MySQL C
  ;;(define connect ...)

                                        ; `create-db' is deprecated in MySQL C
                                        ; use `query' to issue CREATE DATABASE
  ;;(define create-db ...)

  (define data-seek
    (c-lambda ((pointer "MYSQL_RES") unsigned-long) void
              "mysql_data_seek"))

  (define debug
    (c-lambda (nonnull-char-string) void
              "mysql_debug"))

                                        ; `drop-db' is deprecated in MySQL C
                                        ; use `query' to issue DROP DATABASE
  ;;(define drop-db ...)

  (define dump-debug-info
    (c-lambda ((pointer "MYSQL_RES")) bool
              "mysql_dump_debug_info"))

                                        ; `eof' is deprecated in MySQL C
                                        ; use `error' and `errno'
  ;;(define eof ..)

  (define errno
    (c-lambda ((pointer "MYSQL")) unsigned-int
              "mysql_errno"))

  (define mysql-error
    (c-lambda ((pointer "MYSQL")) nonnull-char-string
              "mysql_error"))

                                        ; you should use real-escape-string
                                        ; instead!
  ;;(define escape-string ...)

  (define fetch-field
    (c-lambda ((pointer "MYSQL_RES")) (pointer "MYSQL_FIELD")
              "mysql_fetch_field"))

  (define fetch-fields 
    (c-lambda ((pointer "MYSQL_RES")) (pointer "MYSQL_FIELD")
              "mysql_fetch_fields"))

  (define fetch-row
    (c-lambda ((pointer "MYSQL_RES")) (pointer "MYSQL_ROW")
              "mysql_fetch_row"))

  (define field-count
    (c-lambda ((pointer "MYSQL")) unsigned-int
              "mysql_field_count"))

  (define field-seek
    (c-lambda ((pointer "MYSQL_RES") (pointer "MYSQL_FIELD_OFFSET"))
              (pointer "MYSQL_FIELD_OFFSET")
              "mysql_field_seek"))

  (define field-tell
    (c-lambda ((pointer "MYSQL_RES")) (pointer "MYSQL_FIELD_OFFSET")
              "mysql_field_tell"))

  (define free-result
    (c-lambda ((pointer "MYSQL_RES")) void
              "mysql_free_result"))

  (define get-client-info
    (c-lambda () nonnull-char-string
              "mysql_get_client_info"))

  (define get-host-info
    (c-lambda ((pointer "MYSQL")) nonnull-char-string
              "mysql_get_host_info"))

  (define get-proto-info
    (c-lambda ((pointer "MYSQL")) unsigned-int
              "mysql_get_host_info"))

  (define get-server-info
    (c-lambda ((pointer "MYSQL")) nonnull-char-string
              "mysql_get_server_info"))

  (define info
    (c-lambda ((pointer "MYSQL")) char-string
              "mysql_info"))

  (define init
    (c-lambda ((pointer "MYSQL")) (pointer "MYSQL")
              "mysql_init"))

  (define insert-id
    (c-lambda ((pointer "MYSQL")) unsigned-long
              "mysql_insert_id"))

  (define kill
    (c-lambda ((pointer "MYSQL") unsigned-long) bool
              "mysql_kill"))

  (define list-dbs
    (c-lambda ((pointer "MYSQL") char-string) (pointer "MYSQL_RES")
              "mysql_list_dbs"))

  (define list-fields
    (c-lambda ((pointer "MYSQL") nonnull-char-string char-string)
              (pointer "MYSQL_RES")
              "mysql_list_fields"))

  (define list-processes
    (c-lambda ((pointer "MYSQL")) (pointer "MYSQL_RES")
              "mysql_list_processes"))

  (define list-tables
    (c-lambda ((pointer "MYSQL") char-string) (pointer "MYSQL_RES")
              "mysql_list_tables"))

  (define num-fields
    (c-lambda ((pointer "MYSQL_RES")) unsigned-int
              "mysql_num_fields"))

  (define num-rows
    (c-lambda ((pointer "MYSQL_RES")) unsigned-long
              "mysql_num_rows"))

  ;; `options-*'
  ;;
  ;; The problem here is that the C function is nasty.  It takes an enumerated
  ;; constant and a char const *arg, which changes type based on the value
  ;; of the enumerated constant given.  Indeed, for some values of the
  ;; constant, arg is not used.
  ;;
  ;; For details, see:
  ;; http://www.mysql.com/doc/en/mysql_options.html
  ;;
  ;; I try to clean this up by breaking the function into several Scheme
  ;; procedures, one for each of the enumerated constants, or "options".  The
  ;; formal argument of the procedure corresponds to the option's arg.
  ;;
  ;; Eg.
  ;;    mysql_options(mysql, MYSQL_READ_DEFAULT_FILE, "my.cnf");
  ;;    (options-read-default-file mysql "my.cnf")
  ;;
  ;;    mysql_options(mysql, MYSQL_OPT_COMPRESS, NULL);
  ;;    (options-opt-compress mysql)
  ;;
  ;; Notice above that since arg is not used in the C version, it is not a
  ;; formal parameter of the Scheme counterpart.
  ;;
  ;; All `option-'* procedures return #f on success.

  ;;(define options
  ;;  (c-lambda ((pointer "MYSQL") ...) int
  ;;    "mysql_options"))

  (define options-opt-connect-timeout
    (c-lambda
     ((pointer "MYSQL") unsigned-int) bool
     "___result = mysql_options(___arg1,MYSQL_OPT_CONNECT_TIMEOUT,&___arg2);"))

  (define options-opt-compress
    (c-lambda ((pointer "MYSQL")) bool
              "___result = mysql_options(___arg1, MYSQL_OPT_COMPRESS, NULL);"))

  ;; Differs from the MySQL C API:
  ;; "If no pointer is given or if pointer points to an unsigned int != 0
  ;; the command LOAD LOCAL INFILE is enabled."
  ;; Instead, the logic has been simplified.  Call this procedure (of one
  ;; argument, a mysql connection) to enable the command LOAD LOCAL INFILE.

  ;; Newer than our version of MySQL.
  ;;
  ;;(define options-opt-local-infile
  ;;  (c-lambda
  ;;   ((pointer "MYSQL")) bool
  ;;   "___result = mysql_options(___arg1, MYSQL_OPT_LOCAL_INFILE, NULL);"))

  (define options-opt-named-pipe
    (c-lambda
     ((pointer "MYSQL")) bool
     "___result = mysql_options(___arg1, MYSQL_OPT_NAMED_PIPE, NULL);"))

  (define options-init-command
    (c-lambda
     ((pointer "MYSQL") nonnull-char-string) bool
     "___result = mysql_options(___arg1, MYSQL_INIT_COMMAND, ___arg2);"))

  (define options-read-default-file
    (c-lambda
     ((pointer "MYSQL") nonnull-char-string) bool
     "___result = mysql_options(___arg1, MYSQL_READ_DEFAULT_FILE, ___arg2);"))

  (define options-read-default-group
    (c-lambda
     ((pointer "MYSQL") nonnull-char-string) bool
     "___result = mysql_options(___arg1, MYSQL_READ_DEFAULT_GROUP, ___arg2);"))

  (define ping
    (c-lambda ((pointer "MYSQL")) bool
              "mysql_ping"))

  (define query
    (c-lambda ((pointer "MYSQL") nonnull-char-string) bool
              "mysql_query"))

  (define real-connect
    (c-lambda ((pointer "MYSQL")
               char-string  ; host
               char-string  ; user
               char-string  ; passwd
               char-string  ; db
               unsigned-int ; port
               char-string  ; unix-socket
               unsigned-int); client-flag
              (pointer "MYSQL")
              "mysql_real_connect"))

  ;; FLAGS for real-connect
  (define-c-enums
    client-compress
    client-found-rows
    client-ignore-space
    client-interactive 
    client-no-schema   
    client-odbc        
    ;client-ssl  ;; too new
    )

  (define real-escape-string
    (c-lambda
     ((pointer "MYSQL") nonnull-char-string nonnull-char-string unsigned-long)
     unsigned-long
     "mysql_real_escape_string"))

  (define real-query
    (c-lambda ((pointer "MYSQL") nonnull-char-string unsigned-long) bool
              "mysql_real_query"))

  (define reload
    (c-lambda ((pointer "MYSQL")) bool
              "mysql_reload"))

  (define row-seek
    (c-lambda ((pointer "MYSQL_RES") (pointer "MYSQL_ROW_OFFSET"))
              (pointer "MYSQL_ROW_OFFSET")
              "mysql_row_seek"))

  (define row-tell
    (c-lambda ((pointer "MYSQL_RES"))
              (pointer "MYSQL_ROW_OFFSET")
              "mysql_row_tell"))

  (define select-db
    (c-lambda ((pointer "MYSQL") nonnull-char-string) bool
              "mysql_select_db"))

  (define shutdown
    (c-lambda ((pointer "MYSQL")) bool
              "mysql_shutdown"))

  (define stat
    (c-lambda ((pointer "MYSQL")) char-string
              "mysql_stat"))

  (define store-result
    (c-lambda ((pointer "MYSQL")) (pointer "MYSQL_RES")
              "mysql_store_result"))

  (define thread-id
    (c-lambda ((pointer "MYSQL")) unsigned-long
              "mysql_thread_id"))

  (define use-result
    (c-lambda ((pointer "MYSQL")) (pointer "MYSQL_RES")
              "mysql_use_result"))

  ;; The structures defined by MySQL are only partially supported here.  This
  ;; should change in the future to provide more comprehensive coverage.

  ;; FIELD STRUCTURE ACCESSORS
  (define field->name
    (c-lambda ((pointer "MYSQL_FIELD")) char-string
              "___result = ___arg1->name;"))
 
  (define field->table
    (c-lambda ((pointer "MYSQL_FIELD")) char-string
              "___result = ___arg1->table;"))

  (define field->def
    (c-lambda ((pointer "MYSQL_FIELD")) char-string
              "___result = ___arg1->def;"))
   
  (define field->type
    (c-lambda ((pointer "MYSQL_FIELD")) int
              "___result = ___arg1->type;"))
     
  (define field->length
    (c-lambda ((pointer "MYSQL_FIELD")) unsigned-int
              "___result = ___arg1->length;"))

  (define field->max-length
    (c-lambda ((pointer "MYSQL_FIELD")) unsigned-int
              "___result = ___arg1->max_length;"))

  (define field->flags  
    (c-lambda ((pointer "MYSQL_FIELD")) unsigned-int
              "___result = ___arg1->flags;"))
  
  (define field->decimals
    (c-lambda ((pointer "MYSQL_FIELD")) unsigned-int
              "___result = ___arg1->decimals;"))


  ;; Field type enumerated constants
  (define-c-enums
    field-type-tiny
    field-type-decimal
    field-type-short
    field-type-long       
    field-type-float  
    field-type-double
    field-type-null
    field-type-timestamp
    field-type-longlong   
    field-type-int24
    field-type-date      
    field-type-time
    field-type-datetime   
    field-type-year
    field-type-newdate      ;; not documented in C API
    field-type-enum
    field-type-set
    field-type-tiny-blob    ;; not documented in C API
    field-type-medium-blob  ;; not documented in C API
    field-type-long-blob    ;; not documented in C API
    field-type-blob
    field-type-var-string   ;; not documented in C API
    field-type-string     
    ;; field-type-char      ;; deprecated use `field-type-tiny'.
    ) ;; end field type enumerated constants.

  ;; res structure

  (define result->row-count
    (c-lambda ((pointer "MYSQL_RES")) unsigned-int
	      "___result = ___arg1->row_count;"))

  (define result->field-count
    (c-lambda ((pointer "MYSQL_RES")) unsigned-int
              "___result = ___arg1->field_count;"))

  (define result->current-field
    (c-lambda ((pointer "MYSQL_RES")) unsigned-int
              "___result = ___arg1->current_field;"))

  ;; -> MYSQL_FIELD
  (define result->fields
    (c-lambda ((pointer "MYSQL_RES")) unsigned-int
              "___result = ___arg1->fields;"))

  (define result->data
    (c-lambda ((pointer "MYSQL_RES")) unsigned-int
              "___result = ___arg1->data;")) 


;; Supplement

  ;; This is an UNSAFE operation.  You can go outside the bounds of the array.
  ;; I don't know how else to do this.(?)
  (define row-ref
    (c-lambda ((pointer "MYSQL_ROW") int) char-string
              "___result = ___arg1[___arg2];"))

) ;; end client library