Changeset 7925 in project


Ignore:
Timestamp:
01/25/08 03:13:42 (12 years ago)
Author:
Kon Lovett
Message:

Split test into common section. Added MY_CHARSET_INFO, srfi-12 (instead of error), Options, SSL, Rmvd dep mysql procs., mysql-fetch-lengths, chgd field struct api (more mysql-ish).

Location:
release/3/mysql/trunk
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed
  • release/3/mysql/trunk/eggdoc-mysql.scm

    r7902 r7925  
    3333(let [(db (mysql-connect host: "mysql.example.com" user: "example"
    3434                         passwd: "secret"))]
    35   (if (not db) (error (conc "MySQL connection failed: " (mysql-error db))))
    3635  (mysql-query db "SHOW DATABASES")
    3736  (do [(row (mysql-fetch-row db) (mysql-fetch-row db))]
     
    4746(let [(db (mysql-connect host: "mysql.example.com" user: "example"
    4847                         passwd: "secret"))]
    49   (if (not db) (error (conc "MySQL connection failed: " (mysql-error db))))
    5048  (mysql-query-foreach db "SHOW DATABASES"
    5149                       (lambda (row idx)
     
    8684        (url "mailto:toby@butzon.com" "toby@butzon.com") ".")
    8785
     86      (subsection "Exceptions"
     87     
     88        (p
     89          "Conditions of the kind " (code "(exn mysql)") " are signaled "
     90          "for error conditions.")
     91        (symbol-table "Properties"
     92          (describe location "Where the error occured - usually a procedure name.")
     93          (describe arguments "Values that contributed to the error.")
     94          (describe message "Error message"))
     95      )
     96
    8897      (subsection "Connections"
    8998
     
    95104            "the other MySQL functions. This object is referred to as "
    96105            (tt "DB") " when passed by all the other MySQL functions. "
    97             "Returns " (tt "#f") " when the connection fails.")
     106            "Signals an exception when the connection fails.")
    98107          (p
    99108            "Any number of the following " (tt "KEYWORDS") " may be included:"
     
    105114              (li "port")
    106115              (li "unix-socket")
    107               (li "client-flag")))
     116              (li "client-flag")
     117              #;(li "ssl")
     118              #;(li "options")))
    108119          (p
    109120            "Note that default values are available for all of these "
     
    124135          (p
    125136            "Executes " (tt "SQL-STRING") " on the MySQL server "
    126             "and stores the result in memory. Generates an error "
    127             "(calls " (tt "error") ") if the query fails.") )
     137            "and stores the result in memory. Signals an exception "
     138            "if the query fails.") )
    128139
    129140        (procedure "(mysql-fetch-row DB)"
     
    228239        (subsubsection "Field Set Access"
    229240
    230           (procedure "(mysql-fetch-field-items DB MYSQL-FIELD-GETTER ...)"
    231             (p
    232               "Returns a list of lists of MYSQL_FIELD entry values, "
    233               "a list for each " (tt "MYSQL-FIELD-GETTER") ".")
    234             (p
     241          (procedure "(mysql-field-slots MYSQL-FIELD-POINTER MYSQL-FIELD-GETTER ...)"
     242            (p
     243              "Returns a list of MYSQL_FIELD entry values, "
     244              "from each " (tt "MYSQL-FIELD-GETTER") ".")
     245            (p
     246              (tt "MYSQL-FIELD-POINTER") " is a pointer to a MYSQL_FIELD, or "
     247              (code "#f") ". "
    235248              (tt "MYSQL-FIELD-GETTER") " is a " (code "mysql-field-*") " "
    236249              "reference function.") )
    237250
    238           (procedure "(*mysql-fetch-field-item MYSQL-FIELD-POINTER FIELD-COUNT MYSQL-FIELD-GETTER)"
    239             (p
    240               "Returns a " (tt "FIELD-COUNT") " length list of MYSQL_FIELD entry (object).")
    241             (p
    242               (tt "MYSQL-FIELD-POINTER") " is a pointer to a vector of MYSQL_FIELD. "
    243               (tt "FIELD-COUNT") " is the number of entries in the vector. "
    244               (tt "MYSQL-FIELD-GETTER") " is a " (code "mysql-field-*") " "
    245               "reference function.") )
     251          (procedure "(mysql-fetch-field-slots-direct DB FIELD-NUMBER MYSQL-FIELD-GETTER ...)"
     252            (p
     253              "Combination of " (code "mysql-fetch-field-direct") " and "
     254              (code "mysql-field-slots") ".") )
     255
     256          (procedure "(mysql-fetch-field-slots DB MYSQL-FIELD-GETTER ...)"
     257            (p
     258              "Combination of " (code "mysql-fetch-field") " and "
     259              (code "mysql-field-slots") ".") )
     260
    246261        )
    247262
     
    266281          (procedure "(mysql-field-db MYSQL-FIELD-POINTER)"
    267282            (p
    268               "Returns " (code "pointer -> ?") ".") )
     283              "Returns " (code "string") ".") )
    269284
    270285          (procedure "(mysql-field-catalog MYSQL-FIELD-POINTER)"
    271286            (p
    272               "Returns " (code "pointer -> ?") ".") )
     287              "Returns " (code "string") ".") )
    273288
    274289          (procedure "(mysql-field-def MYSQL-FIELD-POINTER)"
    275290            (p
    276               "Returns " (code "pointer -> ?") ".") )
     291              "Returns " (code "string") ".") )
    277292
    278293          (procedure "(mysql-field-table MYSQL-FIELD-POINTER)"
    279294            (p
    280               "Returns " (code "pointer -> ?") ".") )
     295              "Returns " (code "string") ".") )
    281296
    282297          (procedure "(mysql-field-type MYSQL-FIELD-POINTER)"
     
    337352
    338353        (symbol-table "enum enum_mysql_set_option"
    339           (describe mysql-option-multi-statements-on "")
    340           (describe mysql-option-multi-statements-off "") )
     354          (describe mysql-option-multi-statements-on "MYSQL_OPTION_MULTI_STATEMENTS_ON")
     355          (describe mysql-option-multi-statements-off "MYSQL_OPTION_MULTI_STATEMENTS_OFF") )
    341356
    342357        (symbol-table "enum mysql_option"
    343           (describe mysql-opt-connect-timeout "")
    344           (describe mysql-opt-compress "")
    345           (describe mysql-opt-named-pipe "")
    346           (describe mysql-init-command "")
    347           (describe mysql-read-default-file "")
    348           (describe mysql-read-default-group "")
    349           (describe mysql-set-charset-dir "")
    350           (describe mysql-set-charset-name "")
    351           (describe mysql-opt-local-infile "")
    352           (describe mysql-opt-protocol "")
    353           (describe mysql-shared-memory-base-name "")
    354           (describe mysql-opt-read-timeout "")
    355           (describe mysql-opt-write-timeout "")
    356           (describe mysql-opt-use-result "")
    357           (describe mysql-opt-use-remote-connection "")
    358           (describe mysql-opt-use-embedded-connection "")
    359           (describe mysql-opt-guess-connection "")
    360           (describe mysql-set-client-ip "")
    361           (describe mysql-secure-auth "")
    362           (describe mysql-report-data-truncation "") )
     358          (describe mysql-opt-connect-timeout "MYSQL_OPT_CONNECT_TIMEOUT")
     359          (describe mysql-opt-compress "MYSQL_OPT_COMPRESS")
     360          (describe mysql-opt-named-pipe "MYSQL_OPT_NAMED_PIPE")
     361          (describe mysql-init-command "MYSQL_INIT_COMMAND")
     362          (describe mysql-read-default-file "MYSQL_READ_DEFAULT_FILE")
     363          (describe mysql-read-default-group "MYSQL_READ_DEFAULT_GROUP")
     364          (describe mysql-set-charset-dir "MYSQL_SET_CHARSET_DIR")
     365          (describe mysql-set-charset-name "MYSQL_SET_CHARSET_NAME")
     366          (describe mysql-opt-local-infile "MYSQL_OPT_LOCAL_INFILE")
     367          (describe mysql-opt-protocol "MYSQL_OPT_PROTOCOL")
     368          (describe mysql-shared-memory-base-name "MYSQL_SHARED_MEMORY_BASE_NAME")
     369          (describe mysql-opt-read-timeout "MYSQL_OPT_READ_TIMEOUT")
     370          (describe mysql-opt-write-timeout "MYSQL_OPT_WRITE_TIMEOUT")
     371          (describe mysql-opt-use-result "MYSQL_OPT_USE_RESULT")
     372          (describe mysql-opt-use-remote-connection "MYSQL_OPT_USE_REMOTE_CONNECTION")
     373          (describe mysql-opt-use-embedded-connection "MYSQL_OPT_USE_EMBEDDED_CONNECTION")
     374          (describe mysql-opt-guess-connection "MYSQL_OPT_GUESS_CONNECTION")
     375          (describe mysql-set-client-ip "MYSQL_SET_CLIENT_IP")
     376          (describe mysql-secure-auth "MYSQL_SECURE_AUTH")
     377          (describe mysql-report-data-truncation "MYSQL_REPORT_DATA_TRUNCATION") )
    363378
    364379        (symbol-table "enum enum_field_types"
    365           (describe mysql-type-decimal "")
    366           (describe mysql-type-tiny "")
    367           (describe mysql-type-short "")
    368           (describe mysql-type-long "")
    369           (describe mysql-type-float "")
    370           (describe mysql-type-double "")
    371           (describe mysql-type-null "")
    372           (describe mysql-type-timestamp "")
    373           (describe mysql-type-longlong "")
    374           (describe mysql-type-int24 "")
    375           (describe mysql-type-date "")
    376           (describe mysql-type-time "")
    377           (describe mysql-type-datetime "")
    378           (describe mysql-type-year "")
    379           (describe mysql-type-newdate "")
    380           (describe mysql-type-varchar "")
    381           (describe mysql-type-bit "")
    382           (describe mysql-type-newdecimal "")
    383           (describe mysql-type-enum "")
    384           (describe mysql-type-set "")
    385           (describe mysql-type-tiny-blob "")
    386           (describe mysql-type-medium-blob "")
    387           (describe mysql-type-long-blob "")
    388           (describe mysql-type-blob "")
    389           (describe mysql-type-var-string "")
    390           (describe mysql-type-string "")
    391           (describe mysql-type-geometry "") )
     380          (describe mysql-type-decimal "MYSQL_TYPE_DECIMAL")
     381          (describe mysql-type-tiny "MYSQL_TYPE_TINY")
     382          (describe mysql-type-short "MYSQL_TYPE_SHORT")
     383          (describe mysql-type-long "MYSQL_TYPE_LONG")
     384          (describe mysql-type-float "MYSQL_TYPE_FLOAT")
     385          (describe mysql-type-double "MYSQL_TYPE_DOUBLE")
     386          (describe mysql-type-null "MYSQL_TYPE_NULL")
     387          (describe mysql-type-timestamp "MYSQL_TYPE_TIMESTAMP")
     388          (describe mysql-type-longlong "MYSQL_TYPE_LONGLONG")
     389          (describe mysql-type-int24 "MYSQL_TYPE_INT24")
     390          (describe mysql-type-date "MYSQL_TYPE_DATE")
     391          (describe mysql-type-time "MYSQL_TYPE_TIME")
     392          (describe mysql-type-datetime "MYSQL_TYPE_DATETIME")
     393          (describe mysql-type-year "MYSQL_TYPE_YEAR")
     394          (describe mysql-type-newdate "MYSQL_TYPE_NEWDATE")
     395          (describe mysql-type-varchar "MYSQL_TYPE_VARCHAR")
     396          (describe mysql-type-bit "MYSQL_TYPE_BIT")
     397          (describe mysql-type-newdecimal "MYSQL_TYPE_NEWDECIMAL")
     398          (describe mysql-type-enum "MYSQL_TYPE_ENUM")
     399          (describe mysql-type-set "MYSQL_TYPE_SET")
     400          (describe mysql-type-tiny-blob "MYSQL_TYPE_TINY_BLOB")
     401          (describe mysql-type-medium-blob "MYSQL_TYPE_MEDIUM_BLOB")
     402          (describe mysql-type-long-blob "MYSQL_TYPE_LONG_BLOB")
     403          (describe mysql-type-blob "MYSQL_TYPE_BLOB")
     404          (describe mysql-type-var-string "MYSQL_TYPE_VAR_STRING")
     405          (describe mysql-type-string "MYSQL_TYPE_STRING")
     406          (describe mysql-type-geometry "MYSQL_TYPE_GEOMETRY") )
     407
     408        (symbol-table "MYSQL_FIELD flags"
     409          (describe not-null-flag "NOT-NULL-FLAG")
     410          (describe pri-key-flag "PRI-KEY-FLAG")
     411          (describe unique-key-flag "UNIQUE-KEY-FLAG")
     412          (describe multiple-key-flag "MULTIPLE-KEY-FLAG")
     413          (describe unsigned-flag "UNSIGNED-FLAG")
     414          (describe zerofill-flag "ZEROFILL-FLAG")
     415          (describe binary-flag "BINARY-FLAG")
     416          (describe auto-increment-flag "AUTO-INCREMENT-FLAG")
     417          (describe no-default-value-flag "NO-DEFAULT-VALUE-FLAG") )
    392418      )
    393419    ) ; documentation
     
    417443        "test suite (and probably a slew of bugfixes) with the next release.")
    418444      (p
    419         "Does not return native types.")
    420       (p
    421445        (tt "mysql-escape-string") " is broken when it's used for binary data.")
    422       (p
    423         "Not yet sure how to handle " (tt "unsigned long *") " for "
    424         (tt "foreign-mysql-fetch-lengths") ".")
    425       (p
    426         (tt "foreign-mysql-get-charset-info") " isn't yet supported.")
    427446      (p
    428447        "I need to nail down the supported libmysqlclient versions. Right "
  • release/3/mysql/trunk/mysql-tests.scm

    r7902 r7925  
    22; vim:ts=2:sw=2:et:
    33; mysql-tests.scm,v 1.3 2005/08/04 09:14:44 tbutzon Exp
    4 
    5 (use mysql)
    64
    75(define *user* "example")
     
    97(define *host* #f) ; #f ==> default ==> localhost
    108
    11 #; ;???
    12 (procedure? mysql-connect)
    13 
    14 (define *db* (mysql-connect user: *user* passwd: *passwd* host: *host*))
    15 (print "Database: " *db*)
    16 
    17 (unless *db*
    18   (print "Unable to connect to database.")
    19   (print "You might want to edit \"mysql-tests.scm\" to set *user*, *passwd*, and *host*.")
    20   (exit) )
    21 
    22 (print "MySQL errno: " (mysql-errno *db*))
    23 (print "MySQL error: " (mysql-error *db*))
    24 (newline)
    25 
    26 (define (mysql-print-and-query *db* query)
    27   (print "QUERY: " query)
    28   (mysql-query *db* query))
    29 
    30 (print "Performing query: SHOW DATABASES")
    31 (mysql-print-and-query *db* "SHOW DATABASES")
    32 (print "Number of rows: " (mysql-num-rows *db*))
    33 
    34 (newline)
    35 (print "The rows can be enumerated one-per-line, like this:")
    36 (mysql-foreach-row *db* (lambda (row row-idx)
    37   (display (conc row-idx ": " (row "Database") "\n"))))
    38 
    39 (newline)
    40 (display "Or they can just be comma-separated, like so:")
    41 (mysql-foreach-row *db* (lambda (row row-idx)
    42   (display (conc (row "Database")
    43                  (if (< row-idx (mysql-num-rows *db*)) ", " "\n")))))
    44 
    45 (mysql-print-and-query *db* "DROP DATABASE IF EXISTS mysql_egg_test")
    46 
    47 (mysql-print-and-query *db* "CREATE DATABASE mysql_egg_test")
    48 
    49 (print "selecting database: mysql_egg_test")
    50 (mysql-select-db *db* "mysql_egg_test")
    51 
    52 (newline)
    53 (mysql-print-and-query *db* "CREATE TABLE test1 (
    54   id INTEGER UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY,
    55   testboolnn BOOLEAN NOT NULL,
    56   testbool BOOLEAN DEFAULT NULL
    57   )")
    58 
    59 (newline)
    60 (mysql-print-and-query *db*
    61   "INSERT INTO test1 SET testboolnn=TRUE, testbool=NULL")
    62 (mysql-print-and-query *db*
    63   "INSERT INTO test1 SET testboolnn=FALSE, testbool=FALSE")
    64 
    65 (newline)
    66 (mysql-print-and-query *db* "SELECT testboolnn, testbool FROM test1")
    67 (mysql-foreach-row *db* (lambda (row idx)
    68   (display (conc "row " idx ": testboolnn=" (row "testboolnn")
    69                  ", testbool="
    70                  (row "testbool") "\n"))))
    71 
    72 (newline)
    73 (mysql-print-and-query *db* "SELECT testboolnn, testbool FROM test1")
    74 (let ([names (car (mysql-fetch-field-items *db* mysql-field-name))])
    75   (pretty-print
    76    (mysql-row-map
    77      *db*
    78      (lambda (row idx)
    79        (map (lambda (f) (cons f (row f))) names)))) )
     9(include "mysql-tests-body")
  • release/3/mysql/trunk/mysql.scm

    r7902 r7925  
    1818;;                mysql-connect.
    1919;;                (Thanks to Daniel Sadilek.)
     20;;   2008.01.24 Use of SRFI-12 conditions instead of 'error'.
     21;;              MYSQL_FIELD support.
     22;;              MY_CHARSET_INFO support.
     23;;              More row mapping functions.
     24;;              Options support
     25;;              SSL support
     26;;              Removed deprecated procedures:
     27;;                mysql-create-db
     28;;                mysql-drop-db
     29;;                mysql-eof
     30;;                mysql-reload
     31;;              (Kon Lovett)
    2032;;
    2133;; This egg provides the MySQL C API via Chicken's foreign function
     
    6779<#
    6880
     81(use srfi-4 srfi-12)
    6982(use lolevel)
    7083
     
    7992  (no-procedure-checks-for-usual-bindings)
    8093  (unused
     94    my-charset-info-name-set!
     95    my-charset-info-csname-set!
     96    my-charset-info-comment-set!
     97    my-charset-info-dir-set!
     98    my-charset-info-mbminlen-set!
     99    my-charset-info-mbmaxlen-set!
    81100                mysql-field-db-set!
    82101                mysql-field-type-set!
     
    100119                mysql-field-max-length-set!
    101120                mysql-field-length-set! )
     121  (bound-to-procedure
     122    mysql-error)
    102123  (export
    103 
    104124    ;; direct api
    105125    foreign-mysql-affected-rows
     
    107127    foreign-mysql-character-set-name
    108128    foreign-mysql-close
    109                 #;foreign-mysql-connect
    110                 #;foreign-mysql-create-db
    111129    foreign-mysql-data-seek
    112130    foreign-mysql-debug
    113                 #;foreign-mysql-drop-db
    114131    foreign-mysql-dump-debug-info
    115     foreign-mysql-eof
    116132    foreign-mysql-errno
    117133    foreign-mysql-error
     
    126142    foreign-mysql-field-tell
    127143    foreign-mysql-free-result
    128                 #;foreign-mysql-get-character-set-info
     144                foreign-mysql-get-character-set-info
    129145    foreign-mysql-get-client-info
    130146    foreign-mysql-get-client-version
    131147    foreign-mysql-get-host-info
    132                 #;foreign-mysql-get-proto-info
     148                foreign-mysql-get-proto-info
    133149    foreign-mysql-get-server-info
    134150    foreign-mysql-get-server-version
     
    152168    foreign-mysql-real-escape-string
    153169    foreign-mysql-real-query
    154     foreign-mysql-reload
    155170    foreign-mysql-row-seek
    156171    foreign-mysql-row-tell
     
    179194    mysql-close ; customized
    180195    mysql-connect ; customized
    181                 #;mysql-create-db ; omitted (deprecated)
    182196                #;mysql-data-seek ; omitted (low level)
    183197    mysql-debug
    184                 #;mysql-drop-db ; omitted (deprecated)
    185198    mysql-dump-debug-info
    186                 #;mysql-eof ; omitted (deprecated)
    187199    mysql-errno
    188200    mysql-error ; customized
    189201    mysql-escape-string ; customized
    190                 #;mysql-fetch-field ; unimplemented
    191                 #;mysql-fetch-fields ; unimplemented
    192                 #;mysql-fetch-field-direct ; unimplemented
    193                 #;mysql-fetch-lengths ; unimplemented
     202                mysql-fetch-field
     203                mysql-fetch-fields
     204                mysql-fetch-field-direct
     205                mysql-fetch-lengths ; customized
    194206    mysql-fetch-row ; customized
    195207    mysql-field-count
     
    197209                #;mysql-field-tell ; omitted (low level)
    198210    mysql-free-result
    199                 #;mysql-get-character-set-info ; unimplemented
     211                mysql-get-character-set-info
    200212    mysql-get-client-info
    201213    mysql-get-client-version
    202214    mysql-get-host-info
    203                 #;mysql-get-proto-info
     215                mysql-get-proto-info
    204216    mysql-get-server-info
    205217    mysql-get-server-version
     
    212224                #;mysql-library-end ; omitted (too new)
    213225    mysql-list-dbs
    214                 #;mysql-list-fields ; omitted (nearly deprecated)
     226                mysql-list-fields ; (nearly deprecated)
    215227    mysql-list-processes
    216228    mysql-list-tables
    217229    mysql-num-fields
    218230    mysql-num-rows
    219     mysql-options
    220231    mysql-ping
    221232    mysql-query
     
    223234                #;mysql-real-escape-string ; omitted (use mysql-escape-string)
    224235                #;mysql-real-query ; omitted (use mysql-query)
    225                 #;mysql-reload ; deprecated
    226236                #;mysql-row-seek ; omitted (low level)
    227237                #;mysql-row-tell ; omitted (low level)
    228238    mysql-select-db
    229                 #;mysql-set-character-set ; omitted (too new)
     239                mysql-set-character-set
    230240                #;mysql-set-server-option ; omitted (too new)
    231241                #;mysql-shutdown ; omitted (too new)
    232242                #;mysql-sqlstate ; omitted (too new)
    233                 #;mysql-ssl-set ; omitted (must be integrated into mysql-connect)
    234243    mysql-stat
    235244    mysql-store-result
     
    243252                #;mysql-next-result ; omitted (too new)
    244253
     254    ;; ssl parameters api
     255    make-mysql-ssl
     256    mysql-ssl?
     257    mysql-ssl-key-pathname
     258    mysql-ssl-certificate-pathname
     259    mysql-ssl-certificate-authority-pathname
     260    mysql-ssl-trusted-certificates-pathname
     261    mysql-ssl-ciphers
     262
    245263    ;; "extended" api
    246264    mysql-rewind
     
    257275    mysql-query-foreach
    258276
    259     ;; field struct api
    260     *mysql-fetch-field-item ; this is rather primitive
    261     mysql-fetch-field-items
    262 
     277    ;; MY_CHARSET_INFO api
     278    ; getters
     279    my-charset-info-name
     280    my-charset-info-csname
     281    my-charset-info-comment
     282    my-charset-info-dir
     283    my-charset-info-mbminlen
     284    my-charset-info-mbmaxlen
     285
     286    ;; MYSQL_FIELD api
     287    ; multi-field getters
     288    mysql-field-slots
     289    mysql-fetch-field-slots-direct
     290    mysql-fetch-field-slots
     291    mysql-fetch-field-slot-direct
     292    mysql-fetch-field-slot
     293    ; getters
    263294                mysql-field-name
    264295                mysql-field-org-name
     
    282313                mysql-field-type
    283314
     315    ;; connection client flags
     316    ; values
     317    client-compress
     318    client-found-rows
     319    client-ignore-sigpipe
     320    client-ignore-space
     321    client-interactive
     322    client-local-files
     323    client-multi-results
     324    client-multi-statements
     325    client-no-schema
     326    client-odbc
     327    client-ssl
     328                ; converters
     329    mysql-client-flags-value
     330    mysql-client-flags-symbol
     331
    284332    ;; enum enum_mysql_set_option
     333    ; values
    285334    mysql-option-multi-statements-on
    286335    mysql-option-multi-statements-off
     336                ; converters
     337    mysql-server-option-value
     338    mysql-server-option-symbol
    287339
    288340    ;; enum mysql_option
     341    ; values
    289342    mysql-opt-connect-timeout
    290343    mysql-opt-compress
     
    307360    mysql-secure-auth
    308361    mysql-report-data-truncation
     362                ; converters
     363    mysql-option-value
     364    mysql-option-symbol
    309365
    310366    ;; enum enum_field_types
     367    ; values
    311368        mysql-type-decimal
    312369        mysql-type-tiny
     
    335392        mysql-type-var-string
    336393        mysql-type-string
    337         mysql-type-geometry ) )
     394        mysql-type-geometry
     395                ; converters
     396    mysql-type-value
     397    mysql-type-symbol
     398
     399    ;; field flags
     400    ; values
     401    not-null-flag
     402    pri-key-flag
     403    unique-key-flag
     404    multiple-key-flag
     405    unsigned-flag
     406    zerofill-flag
     407    binary-flag
     408    auto-increment-flag
     409    no-default-value-flag
     410    ; deprecated
     411    enum-flag
     412    set-flag
     413    blob-flag
     414    timestamp-flag
     415                ; converters
     416    mysql-field-flags-value
     417    mysql-field-flags-symbol ) )
    338418
    339419;=======================================================================
     
    357437(define-foreign-type mysql-row c-pointer)
    358438
    359 (define-foreign-enum (enum_mysql_set_option (enum "enum_mysql_set_option"))
     439;-----------------------------------------------------------------------
     440; Private enumeration value constants
     441
     442(define-foreign-enum (mysql-server-option (enum "enum_mysql_set_option"))
    360443  #f  ; No aliases!
    361444  MYSQL_OPTION_MULTI_STATEMENTS_ON
    362445  MYSQL_OPTION_MULTI_STATEMENTS_OFF )
    363446
    364 (define-foreign-enum (mysql_option (enum "mysql_option"))
     447(define-foreign-enum (mysql-option (enum "mysql_option"))
    365448  #f  ; No aliases!
    366449  MYSQL_OPT_CONNECT_TIMEOUT
     
    385468  MYSQL_REPORT_DATA_TRUNCATION )
    386469
    387 (define-foreign-enum (mysql-field-types (enum "enum_field_types"))
     470(define-foreign-enum (mysql-type (enum "enum_field_types"))
    388471  #f  ; No aliases!
    389472  MYSQL_TYPE_DECIMAL
     
    415498  MYSQL_TYPE_GEOMETRY )
    416499
    417 (define-foreign-record (mysql-field "MYSQL_FIELD")
    418   (rename: c-name->scheme-name)
    419   ; No ctor or dtor!
    420 ;; This is incomplete/incorrect - not all C-types correct
    421   (c-string name)                       ; Name of column
    422   (c-string org_name)                   ; Original column name, if an alias
    423   (c-pointer table)                     ; Table of column if column was a field
    424   (c-string org_table)                  ; Org table name, if table was an alias
    425   (c-pointer db)                        ; Database for table
    426   (c-pointer catalog)                     ; Catalog for table
    427   (c-pointer def)                       ; Default value (set by mysql_list_fields)
    428   (unsigned-long length)                ; Width of column (create length)
    429   (unsigned-long max_length)            ; Max width for selected set
    430   (unsigned-integer name_length)
    431   (unsigned-integer org_name_length)
    432   (unsigned-integer table_length)
    433   (unsigned-integer org_table_length)
    434   (unsigned-integer db_length)
    435   (unsigned-integer catalog_length)
    436   (unsigned-integer def_length)
    437   (unsigned-integer flags)              ; Div flags
    438   (unsigned-integer decimals)           ; Number of decimals in field
    439   (unsigned-integer charsetnr)          ; Character set
    440   (mysql-field-types type) )            ; Type of field. See mysql_com.h for types
    441 
    442 (define MYSQL_FIELD_SIZE (foreign-value "sizeof(MYSQL_FIELD)" unsigned-integer))
    443 
    444 (define-macro (gen-public-enum . ?syms)
     500(define-foreign-enum (mysql-field-flags unsigned-int)
     501  #f  ; No aliases!
     502  NOT_NULL_FLAG                                         ; field can't be NULL
     503  PRI_KEY_FLAG                                          ; field is part of a primary key
     504  UNIQUE_KEY_FLAG                                       ; field is part of a unique key
     505  MULTIPLE_KEY_FLAG                                     ; field is part of a key
     506  UNSIGNED_FLAG                                         ; field is unsigned
     507  ZEROFILL_FLAG                                         ; field is zerofill
     508  BINARY_FLAG                                           ; field is binary
     509  AUTO_INCREMENT_FLAG                                   ; field is a autoincrement field
     510  NO_DEFAULT_VALUE_FLAG         ; field doesn't have default value
     511  ; deprecated
     512  ENUM_FLAG                                             ; field is an enum
     513  SET_FLAG                                              ; field is a set
     514  BLOB_FLAG                                             ; field is a blob
     515  TIMESTAMP_FLAG)                                                               ; field is a timestamp
     516
     517(define-foreign-enum (mysql-client-flags unsigned-int)
     518        #f      ; No aliases!
     519        ; Use compression protocol.
     520        CLIENT_COMPRESS
     521        ; Return the number of found (matched) rows, not the number of changed rows.
     522        CLIENT_FOUND_ROWS
     523        ; Prevents the client library from installing a SIGPIPE signal handler. This
     524        ; can be used to avoid conflicts with a handler that the application has
     525        ; already installed.
     526        CLIENT_IGNORE_SIGPIPE
     527        ; Allow spaces after function names. Makes all functions names reserved
     528        ; words.
     529        CLIENT_IGNORE_SPACE
     530        ; Allow interactive_timeout seconds (instead of wait_timeout seconds) of
     531        ; inactivity before closing the connection. The client's session wait_timeout
     532        ; variable is set to the value of the session interactive_timeout variable.
     533        CLIENT_INTERACTIVE
     534        ; Enable LOAD DATA LOCAL handling.
     535        CLIENT_LOCAL_FILES
     536        ; Tell the server that the client can handle multiple result sets from
     537        ; multiple-statement executions or stored procedures. This is automatically set
     538        ; if CLIENT_MULTI_STATEMENTS is set. See the note following this table for more
     539        ; information about this flag.
     540        CLIENT_MULTI_RESULTS
     541        ; Tell the server that the client may send multiple statements in a single
     542        ; string (separated by Ò;Ó). If this flag is not set, multiple-statement
     543        ; execution is disabled. See the note following this table for more information
     544        ; about this flag.
     545        CLIENT_MULTI_STATEMENTS
     546        ; Don't allow the db_name.tbl_name.col_name syntax. This is for ODBC. It
     547        ; causes the parser to generate an error if you use that syntax, which is
     548        ; useful for trapping bugs in some ODBC programs.
     549        CLIENT_NO_SCHEMA
     550        ; Unused.
     551        CLIENT_ODBC
     552        ; Use SSL (encrypted protocol). This option should not be set by application
     553        ; programs; it is set internally in the client library. Instead, use
     554        ; mysql_ssl_set() before calling mysql_real_connect().
     555        CLIENT_SSL)
     556
     557;-----------------------------------------------------------------------
     558; Public enumeration value constants
     559
     560(define-macro (gen-public-enum ?typ . ?syms)
    445561  `(begin
    446562     ,@(map
    447563        (lambda (sym)
    448           `(define ,(string->symbol (c-name->scheme-name (symbol->string sym))) ,sym) )
    449         ?syms)) )
    450 
    451 (gen-public-enum
     564          (if (pair? sym)
     565            `(define ,(car sym) ,(cadr sym))
     566            `(define ,(string->symbol (c-name->scheme-name (symbol->string sym))) ,sym)))
     567        ?syms)
     568     (define (,(string->symbol (string-append (symbol->string ?typ) "-value")) . syms)
     569       (,(string->symbol (string-append (symbol->string ?typ) "->number")) syms))
     570     (define (,(string->symbol (string-append (symbol->string ?typ) "-symbol")) val)
     571       (,(string->symbol (string-append "number->" (symbol->string ?typ))) val))) )
     572
     573(gen-public-enum mysql-server-option
    452574  MYSQL_OPTION_MULTI_STATEMENTS_ON
    453575  MYSQL_OPTION_MULTI_STATEMENTS_OFF)
    454576
    455 (gen-public-enum
     577(gen-public-enum mysql-option
    456578  MYSQL_OPT_CONNECT_TIMEOUT
    457579  MYSQL_OPT_COMPRESS
     
    475597  MYSQL_REPORT_DATA_TRUNCATION)
    476598
    477 (gen-public-enum
     599(gen-public-enum mysql-type
    478600  MYSQL_TYPE_DECIMAL
    479601        MYSQL_TYPE_TINY
     
    504626  MYSQL_TYPE_GEOMETRY)
    505627
     628(gen-public-enum mysql-field-flags
     629  NOT_NULL_FLAG
     630  PRI_KEY_FLAG
     631  UNIQUE_KEY_FLAG
     632  MULTIPLE_KEY_FLAG
     633  UNSIGNED_FLAG
     634  ZEROFILL_FLAG
     635  BINARY_FLAG
     636  AUTO_INCREMENT_FLAG
     637  NO_DEFAULT_VALUE_FLAG
     638  ; deprecated
     639  ENUM_FLAG
     640  SET_FLAG
     641  BLOB_FLAG
     642  TIMESTAMP_FLAG)
     643
     644(gen-public-enum mysql-client-flags
     645  CLIENT_COMPRESS
     646  CLIENT_FOUND_ROWS
     647  CLIENT_IGNORE_SIGPIPE
     648  CLIENT_IGNORE_SPACE
     649  CLIENT_INTERACTIVE
     650  CLIENT_LOCAL_FILES
     651  CLIENT_MULTI_RESULTS
     652  CLIENT_MULTI_STATEMENTS
     653  CLIENT_NO_SCHEMA
     654  CLIENT_ODBC
     655  CLIENT_SSL)
     656
     657;-----------------------------------------------------------------------
     658; Struct API
     659
     660(define-foreign-record (mysql-field "MYSQL_FIELD")
     661  (rename: c-name->scheme-name)
     662  ; No ctor or dtor
     663  (c-string name)                       ; Name of column
     664  (c-string org_name)                   ; Original column name, if an alias
     665  (c-string table)                      ; Table of column if column was a field
     666  (c-string org_table)                  ; Org table name, if table was an alias
     667  (c-string db)                         ; Database for table
     668  (c-string catalog)                      ; Catalog for table
     669  (c-string def)                        ; Default value (set by mysql_list_fields)
     670  (unsigned-long length)                ; Width of column (create length)
     671  (unsigned-long max_length)            ; Max width for selected set
     672  (unsigned-integer name_length)
     673  (unsigned-integer org_name_length)
     674  (unsigned-integer table_length)
     675  (unsigned-integer org_table_length)
     676  (unsigned-integer db_length)
     677  (unsigned-integer catalog_length)
     678  (unsigned-integer def_length)
     679  (unsigned-integer flags)              ; Div flags
     680  (unsigned-integer decimals)           ; Number of decimals in field
     681  (unsigned-integer charsetnr)          ; Character set
     682  (mysql-type type) )                   ; Type of field. See mysql_com.h for types
     683
     684(define-foreign-record (my-charset-info "MY_CHARSET_INFO")
     685  (rename: c-name->scheme-name)
     686  (constructor: allocate-my-charset-info)
     687  (destructor: free-my-charset-info)
     688  (c-string name)                     ; character set name
     689  (c-string csname)                 ; collation name
     690  (c-string comment)              ; comment
     691  (c-string dir)                ; directory
     692  (unsigned-integer mbminlen)   ; multi byte character min. length
     693  (unsigned-integer mbmaxlen) ) ; multi byte character max. length
     694
     695;-----------------------------------------------------------------------
     696; Foreign function definitions for the MySQL C API using the
     697; MySQL "my_ulonglong" type.
     698;
     699; We treat "my_ulonglong" in Scheme as the "number" type & as a
     700; "double" in the C interface, converting to "my_ulonglong"
     701; to/from the MySQL API.
     702
     703#>
     704static double
     705C_mysql_affected_rows (MYSQL *mysql)
     706{
     707  return ((double) mysql_affected_rows (mysql));
     708}
     709
     710static double
     711C_mysql_insert_id (MYSQL *mysql)
     712{
     713  return ((double) mysql_insert_id (mysql));
     714}
     715
     716static double
     717C_mysql_num_rows (MYSQL_RES *result)
     718{
     719  return ((double) mysql_num_rows (result));
     720}
     721
     722static void
     723C_mysql_data_seek (MYSQL_RES *result, double offset)
     724{
     725  mysql_data_seek (result, (my_ulonglong) offset);
     726}
     727<#
     728
     729; just to be specific
     730(define-foreign-type my-ulonglong number)
     731
     732; 24.2.3.1. mysql_affected_rows()
     733; my_ulonglong mysql_affected_rows(MYSQL *mysql)
     734(define foreign-mysql-affected-rows
     735  (foreign-lambda my-ulonglong "C_mysql_affected_rows" mysql-ptr))
     736
     737; 24.2.3.34. mysql_insert_id()
     738; my_ulonglong mysql_insert_id(MYSQL *mysql)
     739(define foreign-mysql-insert-id
     740  (foreign-lambda my-ulonglong "C_mysql_insert_id" mysql-ptr))
     741
     742; 24.2.3.43. mysql_num_rows()
     743; my_ulonglong mysql_num_rows(MYSQL_RES *result)
     744(define foreign-mysql-num-rows
     745  (foreign-lambda my-ulonglong "C_mysql_num_rows" mysql-res-ptr))
     746
     747; 24.2.3.7. mysql_data_seek()
     748; void mysql_data_seek(MYSQL_RES *result, my_ulonglong offset)
     749(define foreign-mysql-data-seek
     750  (foreign-lambda void "C_mysql_data_seek" mysql-res-ptr my-ulonglong))
     751
     752;-----------------------------------------------------------------------
     753; Foreign function definitions for mysql_options from MySQL C API.
     754;
     755
     756#>
     757static int
     758C_mysql_options_none (MYSQL *mysql, enum mysql_option option)
     759{
     760  return (mysql_options (mysql, option, NULL));
     761}
     762
     763static int
     764C_mysql_options_string (MYSQL *mysql, enum mysql_option option, char *value)
     765{
     766  return (mysql_options (mysql, option, value));
     767}
     768
     769static int
     770C_mysql_options_ulong (MYSQL *mysql, enum mysql_option option, unsigned long value)
     771{
     772  return (mysql_options (mysql, option, &value));
     773}
     774<#
     775
     776(define (%mysql-options mysqlptr option value)
     777  (cond [(null? value)
     778          ((foreign-lambda int "C_mysql_options_none" mysql-ptr mysql-option)
     779           mysqlptr option)]
     780        [(string? value)
     781          ((foreign-lambda int "C_mysql_options_string" mysql-ptr mysql-option c-string)
     782            mysqlptr option value)]
     783        [(number? value)
     784          ((foreign-lambda int "C_mysql_options_ulong" mysql-ptr mysql-option unsigned-long)
     785            mysqlptr option value)]) )
     786
    506787;-----------------------------------------------------------------------
    507788; Foreign function definitions from MySQL C API.
     
    514795;
    515796
    516 ; 24.2.3.1. mysql_affected_rows()
    517 ; my_ulonglong mysql_affected_rows(MYSQL *mysql)
    518 ; note: my_ulonglong is (possibly incorrectly) mapped directly to
    519 ; unsigned-long. it should be a long long, but i'm not sure how to get
    520 ; closer to that than this for now.
    521 (define foreign-mysql-affected-rows
    522   (foreign-lambda unsigned-long "mysql_affected_rows" mysql-ptr))
     797; just to be specific
     798(define-foreign-type my-bool bool)
    523799
    524800; 24.2.3.2. mysql_change_user()
     
    526802;   const char *password, const char *db)
    527803(define foreign-mysql-change-user
    528   (foreign-lambda bool "mysql_change_user" mysql-ptr c-string c-string
     804  (foreign-lambda my-bool "mysql_change_user" mysql-ptr c-string c-string
    529805                  c-string))
    530806
     
    539815  (foreign-lambda void "mysql_close" mysql-ptr))
    540816
    541 ; 24.2.3.5. mysql_connect()
    542 ; MYSQL *mysql_connect(MYSQL *mysql, const char *host, const char *user,
    543 ;   const char *passwd)
    544 ;; no, this is deprecated.
    545 ;;(define foreign-mysql-connect
    546 ;;  (foreign-lambda mysql-ptr "mysql_connect" mysql-ptr c-string c-string
    547 ;;                  c-string))
    548 
    549 ; 24.2.3.6. mysql_create_db()
    550 ; int mysql_create_db(MYSQL *mysql, const char *db)
    551 ;; no, this is deprecated.
    552 ;;(define foreign-mysql-create-db
    553 ;;  (foreign-lambda integer "mysql_create_db" mysql-ptr c-string))
    554 
    555 ; 24.2.3.7. mysql_data_seek()
    556 ; void mysql_data_seek(MYSQL_RES *result, my_ulonglong offset)
    557 (define foreign-mysql-data-seek
    558   (foreign-lambda void "mysql_data_seek" mysql-res-ptr unsigned-long))
    559 
    560817; 24.2.3.8. mysql_debug()
    561818; void mysql_debug(const char *debug)
     
    563820  (foreign-lambda void "mysql_debug" c-string))
    564821
    565 ; 24.2.3.9. mysql_drop_db()
    566 ; int mysql_drop_db(MYSQL *mysql, const char *db)
    567 ;; no, this is deprecated.
    568 ;;(define foreign-mysql-drop-db
    569 ;;  (foreign-lambda integer "mysql_drop_db" mysql-ptr c-string))
    570 
    571822; 24.2.3.10. mysql_dump_debug_info()
    572823; int mysql_dump_debug_info(MYSQL *mysql)
    573824(define foreign-mysql-dump-debug-info
    574825  (foreign-lambda integer "mysql_dump_debug_info" mysql-ptr))
    575 
    576 ; 24.2.3.11. mysql_eof()
    577 ; my_bool mysql_eof(MYSQL_RES *result)
    578 (define foreign-mysql-eof
    579   (foreign-lambda bool "mysql_eof" mysql-res-ptr))
    580826
    581827; 24.2.3.12. mysql_errno()
     
    613859
    614860; 24.2.3.18. mysql_fetch_lengths()
    615 (define (foreign-mysql-fetch-lengths . args)
    616   (error 'foreign-mysql-fetch-lengths "UNIMPLEMENTED (req. ulong vector)"))
     861; unsigned long *mysql_fetch_lengths(MYSQL_RES *result)
     862(define foreign-mysql-fetch-lengths
     863  (foreign-lambda (c-pointer unsigned-long) "mysql_fetch_lengths" mysql-res-ptr))
    617864
    618865; 24.2.3.19. mysql_fetch_row()
     
    643890  (foreign-lambda void "mysql_free_result" mysql-res-ptr))
    644891
    645 ; 24.2.3.24. mysql_get_character_set_info() -- only in MySQL > 5.0.10
     892; 24.2.3.26.Êmysql_get_character_set_info()
     893; void mysql_get_character_set_info(MYSQL *mysql, MY_CHARSET_INFO *cs)
     894(define foreign-mysql-get-character-set-info
     895  (foreign-lambda void "mysql_get_character_set_info" mysql-ptr my-charset-info))
    646896
    647897; 24.2.3.25. mysql_get_client_info()
     
    662912; 24.2.3.28. mysql_get_proto_info()
    663913; unsigned int mysql_get_proto_info(MYSQL *mysql)
    664 ;(define foreign-mysql-get-proto-info
    665 ;  (foreign-lambda unsigned-integer "mysql_get_proto_info" mysql-ptr))
     914(define foreign-mysql-get-proto-info
     915  (foreign-lambda unsigned-integer "mysql_get_proto_info" mysql-ptr))
    666916
    667917; 24.2.3.29. mysql_get_server_info()
     
    692942  (foreign-lambda mysql-ptr "mysql_init" mysql-ptr))
    693943
    694 ; 24.2.3.34. mysql_insert_id()
    695 ; my_ulonglong mysql_insert_id(MYSQL *mysql)
    696 (define foreign-mysql-insert-id
    697   (foreign-lambda unsigned-long "mysql_insert_id" mysql-ptr))
    698 
    699944; 24.2.3.35. mysql_kill()
    700945; int mysql_kill(MYSQL *mysql, unsigned long pid)
     
    739984  (foreign-lambda unsigned-integer "mysql_num_fields" mysql-res-ptr))
    740985
    741 ; 24.2.3.43. mysql_num_rows()
    742 ; my_ulonglong mysql_num_rows(MYSQL_RES *result)
    743 (define foreign-mysql-num-rows
    744   (foreign-lambda unsigned-long "mysql_num_rows" mysql-res-ptr))
    745 
    746986; 24.2.3.44. mysql_options()
    747987; int mysql_options(MYSQL *mysql, enum mysql_option option, const char *arg)
    748988(define foreign-mysql-options
    749   (foreign-lambda integer "mysql_options" mysql-ptr mysql_option c-string))
     989  (foreign-lambda integer "mysql_options" mysql-ptr mysql-option c-pointer))
    750990
    751991; 24.2.3.45. mysql_ping()
     
    755995
    756996; 24.2.3.46. mysql_query()
    757 (define (foreign-mysql-query . args)
    758   (error 'foreign-mysql-query "UNIMPLEMENTED (use mysql_real_query instead)"))
     997; int mysql_query(MYSQL *mysql, const char *stmt_str)
     998;
     999; NOTE: use "mysql_real_query" instead
     1000(define foreign-mysql-query
     1001  (foreign-lambda integer "mysql_query" mysql-ptr c-string))
    7591002
    7601003; 24.2.3.47. mysql_real_connect()
     
    7631006;   const char *unix_socket, unsigned long client_flag)
    7641007(define foreign-mysql-real-connect
    765   (foreign-lambda mysql-ptr "mysql_real_connect" mysql-ptr
    766                   c-string c-string c-string c-string ; host user pwd db
    767                   unsigned-integer ; port, 0 for default
    768                   c-string ; unix_socket, NULL for default
    769                   unsigned-long ; client_flag
    770                   ))
     1008  (foreign-lambda mysql-ptr "mysql_real_connect"
     1009                  mysql-ptr c-string c-string
     1010                  c-string c-string unsigned-integer
     1011                  c-string unsigned-long))
    7711012
    7721013; 24.2.3.48. mysql_real_escape_string()
     
    7831024                  unsigned-long))
    7841025
    785 ; 24.2.3.50. mysql_reload()
    786 (define (foreign-mysql-reload . args)
    787   (error 'foreign-mysql-reload "UNIMPLEMENTED (deprecated in MySQL C API)"))
    788 
    7891026; 24.2.3.51. mysql_row_seek()
    7901027; MYSQL_ROW_OFFSET mysql_row_seek(MYSQL_RES *result, MYSQL_ROW_OFFSET offset)
     
    8101047; int mysql_set_server_option(MYSQL *mysql, enum enum_mysql_set_option option)
    8111048(define foreign-mysql-set-server-option
    812   (foreign-lambda integer "mysql_set_server_option" mysql-ptr enum_mysql_set_option))
     1049  (foreign-lambda integer "mysql_set_server_option" mysql-ptr mysql-server-option))
    8131050
    8141051; 24.2.3.56. mysql_shutdown()
     
    8571094; my_bool mysql_commit(MYSQL *mysql)
    8581095(define foreign-mysql-commit
    859   (foreign-lambda bool "mysql_commit" mysql-ptr))
     1096  (foreign-lambda my-bool "mysql_commit" mysql-ptr))
    8601097
    8611098; 24.2.3.65. mysql_rollback()
    8621099; my_bool mysql_rollback(MYSQL *mysql)
    8631100(define foreign-mysql-rollback
    864   (foreign-lambda bool "mysql_rollback" mysql-ptr))
     1101  (foreign-lambda my-bool "mysql_rollback" mysql-ptr))
    8651102
    8661103; 24.2.3.66. mysql_autocommit()
    8671104; my_bool mysql_autocommit(MYSQL *mysql, my_bool mode)
    8681105(define foreign-mysql-autocommit
    869   (foreign-lambda bool "mysql_autocommit" mysql-ptr bool))
     1106  (foreign-lambda my-bool "mysql_autocommit" mysql-ptr my-bool))
    8701107
    8711108; 24.2.3.67. mysql_more_results()
    8721109; my_bool mysql_more_results(MYSQL *mysql)
    8731110(define foreign-mysql-more-results
    874   (foreign-lambda bool "mysql_more_results" mysql-ptr))
     1111  (foreign-lambda my-bool "mysql_more_results" mysql-ptr))
    8751112
    8761113; 24.2.3.68. mysql_next_result()
     
    9001137; few additional features have been layered on.
    9011138;
     1139
     1140; record printer helper
     1141(define (record-slot->string val lbl #!optional (tst val))
     1142  (if tst (conc #\space lbl #\: #\space #\" val #\") "") )
     1143
     1144;-----------------------------------------------------------------------
     1145; MySQL exceptions
     1146
     1147(define (make-exn-condition loc msg . args)
     1148  (make-property-condition 'exn 'location loc 'message msg 'arguments args) )
     1149
     1150(define (make-mysql-condition)
     1151  (make-property-condition 'mysql) )
     1152
     1153(define (make-exn-mysql-condition loc msg . args)
     1154  (make-composite-condition
     1155   (apply make-exn-condition loc msg args)
     1156   (make-mysql-condition)) )
     1157
     1158(define (signal-mysql-condition loc msg . args)
     1159  (signal (apply make-exn-mysql-condition loc msg args)) )
     1160
     1161(define (signal-mysql-error loc conn . args)
     1162  (apply signal-mysql-condition loc (mysql-error conn) args) )
     1163
     1164;-----------------------------------------------------------------------
     1165; MySQL "SSL" record type definition.
     1166;
     1167; See <http://www.openssl.org/docs/apps/ciphers.html> for a discussion
     1168; of the cipher-list format.
     1169
     1170(define-record-type mysql-ssl
     1171  (%make-mysql-ssl key cert ca capath cipher)
     1172  mysql-ssl?
     1173  (key mysql-ssl-key-pathname)
     1174  (cert mysql-ssl-certificate-pathname)
     1175  (ca mysql-ssl-certificate-authority-pathname)
     1176  (capath mysql-ssl-trusted-certificates-pathname)
     1177  (cipher mysql-ssl-ciphers) )
     1178
     1179(define (make-mysql-ssl #!key key certificate certificate-authority
     1180                              trusted-certificates ciphers)
     1181  (%make-mysql-ssl key certificate certificate-authority trusted-certificates ciphers) )
     1182
     1183(define-record-printer (mysql-ssl ssl out)
     1184  (let ([key (mysql-ssl-key-pathname ssl)]
     1185        [cert (mysql-ssl-certificate-pathname ssl)]
     1186        [ca (mysql-ssl-certificate-authority-pathname ssl)]
     1187        [capath (mysql-ssl-trusted-certificates-pathname ssl)]
     1188        [cipher (mysql-ssl-ciphers ssl)])
     1189    (display
     1190     (string-append
     1191      "#<mysql-ssl"
     1192      (record-slot->string key      "key")
     1193      (record-slot->string cert     "cert")
     1194      (record-slot->string ca       "ca")
     1195      (record-slot->string capath   "capath")
     1196      (record-slot->string cipher   "cipher")
     1197      ">")
     1198     out) ) )
    9021199
    9031200;-----------------------------------------------------------------------
     
    9261223(define-record-type mysql-connection
    9271224  (make-mysql-connection host user passwd db port unix-socket
    928                          client-flag ptr result result-start)
     1225                         client-flag ptr result result-start
     1226                         ssl opts)
    9291227  mysql-connection?
    9301228  (host mysql-connection-host)
     
    9371235  (ptr mysql-connection-ptr mysql-connection-ptr-set!)
    9381236  (result mysql-connection-result mysql-connection-result-set!)
    939   (result-start mysql-connection-result-start mysql-connection-result-start-set!) )
    940 
    941 ;; this could probably be less ugly... oh well.
     1237  (result-start mysql-connection-result-start mysql-connection-result-start-set!)
     1238  (ssl mysql-connection-ssl)
     1239  (opts mysql-connection-options) )
     1240
    9421241(define-record-printer (mysql-connection conn out)
    9431242  (let [(host (mysql-connection-host conn))
     
    9481247        (unix-socket (mysql-connection-unix-socket conn))
    9491248        (client-flag (mysql-connection-client-flag conn))
    950         (to-fld-str
    951           (lambda (val lbl #!optional (tst val))
    952             (if tst (format #f " ~A: \"~A\"" lbl val) "") ) )]
    953     (display (conc "#<mysql-connection"
    954                    (if (mysql-connection-ptr conn)
    955                        (conc
    956                          (to-fld-str host         "host")
    957                          (to-fld-str user         "user")
    958                          (to-fld-str passwd       "passwd")
    959                          (to-fld-str db           "db")
    960                          (to-fld-str tcp-port     "tcp-port"    (not (fx= 0 tcp-port)))
    961                          (to-fld-str unix-socket  "unix-socket")
    962                          (to-fld-str client-flag  "client-flag" (not (fx= 0 client-flag))) )
    963                        " INVALID")
    964                    ">")
    965              out) ) )
     1249        (ssl (mysql-connection-ssl conn))
     1250        (opts (mysql-connection-options conn))]
     1251    (display
     1252     (string-append
     1253      "#<mysql-connection"
     1254      (if (mysql-connection-ptr conn)
     1255          (string-append
     1256            (record-slot->string host         "host")
     1257            (record-slot->string user         "user")
     1258            (record-slot->string passwd       "passwd")
     1259            (record-slot->string db           "db")
     1260            (record-slot->string tcp-port     "tcp-port"    (not (zero? tcp-port)))
     1261            (record-slot->string unix-socket  "unix-socket")
     1262            (record-slot->string client-flag  "client-flag" (not (zero? client-flag)))
     1263            (record-slot->string ssl          "ssl")
     1264            (record-slot->string opts         "options") )
     1265          " INVALID")
     1266      ">")
     1267     out) ) )
    9661268
    9671269;-----------------------------------------------------------------------
     
    9921294; Returns a mysql connection object, or #f on failure.
    9931295(define (mysql-connect #!key (host #f) (user #f) (passwd #f) (db #f) (port 0)
    994                        (unix-socket #f) (client-flag 0))
    995   (let [(mysql (foreign-mysql-init #f))]
    996     (if mysql
    997         (let [(mysql-ptr (foreign-mysql-real-connect mysql host user passwd db
    998                                                      port unix-socket
    999                                                      client-flag))]
    1000           (if mysql-ptr
     1296                       (unix-socket #f) (client-flag 0)
     1297                       (options #f) (ssl #f))
     1298  (let ([mysql (foreign-mysql-init #f)])
     1299    (cond
     1300      [mysql
     1301        (when ssl
     1302          (foreign-mysql-ssl-set mysql
     1303                                 (mysql-ssl-key-pathname ssl)
     1304                                 (mysql-ssl-certificate-pathname ssl)
     1305                                 (mysql-ssl-certificate-authority-pathname ssl)
     1306                                 (mysql-ssl-trusted-certificates-pathname ssl)
     1307                                 (mysql-ssl-ciphers ssl)) )
     1308        (when options
     1309          (for-each
     1310           (lambda (optitm)
     1311             (let ([opt (car optitm)]
     1312                   [val (cdr optitm)])
     1313               (unless (zero? (%mysql-options mysql opt val))
     1314                 (signal-mysql-condition 'mysql-connect "unknown option code" opt val))))
     1315           options) )
     1316        (let ([mysqlptr (foreign-mysql-real-connect mysql host user passwd db
     1317                                                    port unix-socket
     1318                                                    client-flag)])
     1319          (if mysqlptr
    10011320              (make-mysql-connection host user passwd db port unix-socket
    1002                                      client-flag mysql-ptr #f #f)
    1003               (error (foreign-mysql-error mysql)) ) )
    1004         (error "failed to initialize mysql") ) ) )
     1321                                     client-flag mysqlptr #f #f options ssl)
     1322              (signal-mysql-condition 'mysql-connect
     1323               (foreign-mysql-error mysql)
     1324               host user passwd db port unix-socket client-flag) ) ) ]
     1325      [else
     1326        (signal-mysql-condition 'mysql-connect "failed to initialize mysql") ] ) ) )
    10051327
    10061328(define (mysql-debug debug)
     
    10191341    (and (not (string=? "" errstr))
    10201342         errstr) ) )
    1021 
    1022 ;; XXX: is this the best way to do allocate/free for this?
    1023 #;
    1024 (define (mysql-escape-string conn str)
    1025   (let* [(len (string-length str))
    1026          (lolevel-string (allocate (fx+ (fx* 2 len) 1)))]
    1027     (foreign-mysql-real-escape-string (mysql-connection-ptr conn)
    1028                                       lolevel-string
    1029                                       str len)
    1030     (let [(scm-str (pointer->object lolevel-string))]
    1031       (free lolevel-string)
    1032       scm-str) ) )
    10331343
    10341344(define (mysql-escape-string conn str)
     
    10421352    escstr ) )
    10431353
    1044 ;; TODO: mysql-fetch-field (requires MYSQL_FIELD)
    1045 ;; TODO: mysql-fetch-fields (requires MYSQL_FIELD)
    1046 ;; TODO: mysql-fetch-field-direct (requires MYSQL_FIELD)
    1047 ;; TODO: mysql-fetch-lengths (returns unsigned long *)
     1354; returns a mysql-field-ptr or #f when no more fields.
     1355; returns #f when no result set.
     1356(define (mysql-fetch-field conn)
     1357  (and-let* ([resptr (mysql-connection-result conn)])
     1358    (foreign-mysql-fetch-field resptr) ) )
     1359
     1360; returns a mysql-field-ptr to a vector of MYSQL_FIELD or #f when no fields.
     1361; returns #f when no result set.
     1362(define (mysql-fetch-fields conn)
     1363  (and-let* ([resptr (mysql-connection-result conn)])
     1364    (foreign-mysql-fetch-fields resptr) ) )
     1365
     1366; returns a mysql-field-ptr or #f when no such field.
     1367; returns #f when no result set.
     1368(define (mysql-fetch-field-direct conn field-number)
     1369  (and-let* ([resptr (mysql-connection-result conn)])
     1370    (foreign-mysql-fetch-field-direct resptr field-number) ) )
     1371
     1372; returns a u32vector of length num-fields.
     1373; returns #f when no result set.
     1374; signals an exception upon error.
     1375(define (mysql-fetch-lengths conn)
     1376  (and-let* ([resptr (mysql-connection-result conn)])
     1377    (let ([ulongptr (foreign-mysql-fetch-lengths resptr)])
     1378      (if ulongptr
     1379          (let* ([numflds (foreign-mysql-num-fields resptr)]
     1380                 [siz (* numflds 4)]
     1381                 [store (make-blob siz)])
     1382            (move-memory! ulongptr store siz)
     1383            (blob->u32vector/shared store) )
     1384          (signal-mysql-condition 'mysql-fetch-lengths "no rows to fetch") ) ) ) )
    10481385
    10491386; After a mysql-query that has results, use mysql-fetch-row to retrieve
     
    10771414  (mysql-connection-result-start-set! conn #f) )
    10781415
    1079 ;; TODO: foreign-mysql-get-character-set-info (requires MY_CHARSET_INFO)
     1416; returns a c-pointer to a MY_CHARSET_INFO struct.
     1417; a finalizer is supplied.
     1418(define (mysql-get-character-set-info conn)
     1419  (let ([chrsetinfo (allocate-my-charset-info)])
     1420    (foreign-mysql-get-character-set-info (mysql-connection-ptr conn) chrsetinfo)
     1421    (set-finalizer! chrsetinfo free-my-charset-info)
     1422    chrsetinfo ) )
    10801423
    10811424(define (mysql-get-client-info)
     
    10881431  (foreign-mysql-get-host-info (mysql-connection-ptr conn)) )
    10891432
    1090 #;
     1433;
    10911434(define (mysql-get-proto-info conn)
    10921435  (foreign-mysql-get-proto-info (mysql-connection-ptr conn)) )
     
    11121455    (foreign-mysql-list-dbs (mysql-connection-ptr conn) like)) )
    11131456
     1457(define (mysql-list-fields conn table wild)
     1458  (mysql-free-result conn)
     1459  (mysql-connection-result-set! conn
     1460    (foreign-mysql-list-fields (mysql-connection-ptr conn) table wild)) )
     1461
    11141462(define (mysql-list-processes conn)
    11151463  (mysql-free-result conn)
     
    11291477    (foreign-mysql-num-rows res)) )
    11301478
    1131 (define (mysql-options conn option arg)
    1132   (foreign-mysql-options (mysql-connection-ptr conn) option arg) )
    1133 
    11341479(define (mysql-ping conn)
    11351480  (foreign-mysql-ping (mysql-connection-ptr conn)) )
    11361481
    1137 ; returns #t if the query was successful, #f otherwise.
     1482; returns #t if the query was successful, signals exception otherwise.
    11381483(define (mysql-query conn query)
    11391484  (let [(mysql-ptr (mysql-connection-ptr conn))]
    11401485    ; zero indicates success
    1141     (if (fx= 0 (foreign-mysql-real-query mysql-ptr query (string-length query)))
     1486    (if (zero? (foreign-mysql-real-query mysql-ptr query (string-length query)))
    11421487        (begin (mysql-store-result conn) #t)
    1143         (error (conc "mysql-query failed: " (mysql-error conn))) ) ) )
    1144 
     1488        (signal-mysql-error 'mysql-query conn query) ) ) )
     1489
     1490; returns #t if the select was successful, signals exception otherwise.
    11451491(define (mysql-select-db conn db)
    1146   (or (fx= 0 (foreign-mysql-select-db (mysql-connection-ptr conn) db))
    1147       (error (conc "mysql-select-db failed: " (mysql-error))) ) )
     1492  (or (zero? (foreign-mysql-select-db (mysql-connection-ptr conn) db))
     1493      (signal-mysql-error 'mysql-select-db conn db) ) )
     1494
     1495; returns #t if the set was successful, signals exception otherwise.
     1496(define (mysql-set-character-set conn csname)
     1497  (or (zero? (foreign-mysql-set-character-set (mysql-connection-ptr conn) csname))
     1498      (signal-mysql-condition 'mysql-set-character-set "bad character set name" csname) ) )
    11481499
    11491500(define (mysql-stat conn)
     
    11971548      (let ([row (mysql-fetch-row conn)])
    11981549        (if row
    1199             (loop (fx+ rownum 1) (proc row rownum acc))
     1550            (loop (+ rownum 1) (proc row rownum acc))
    12001551            acc ) ) ) ) )
    12011552
     
    12481599  (mysql-row-map conn proc) )
    12491600
    1250 ;
     1601; synonyms
    12511602(define mysql-query-foreach mysql-query-for-each)
    12521603(define mysql-foreach-row mysql-row-for-each)
    12531604
    12541605;-----------------------------------------------------------------------
    1255 ; The MySQL Field structure API.
    1256 
    1257 ; returns list of MYSQL_FIELD entry (object).
    1258 (define (*mysql-fetch-field-item field-pointer field-count field-getter)
    1259   (let loop ([fldptr field-pointer]
    1260              [cnt field-count]
    1261              [lst '()])
    1262     (if (fx<= cnt 0)
    1263         lst
    1264         (loop (pointer-offset fldptr MYSQL_FIELD_SIZE)
    1265               (fx- cnt 1)
    1266               (cons (field-getter fldptr) lst)) ) ) )
    1267 
    1268 ; returns list of list of field items (object), or #f.
    1269 (define (mysql-fetch-field-items conn . field-getters)
    1270   (and-let* ([res (mysql-connection-result conn)])
    1271     (let ([field-pointer (foreign-mysql-fetch-fields res)]
    1272           [field-count (foreign-mysql-num-fields res)])
    1273       (map
    1274        (cut *mysql-fetch-field-item field-pointer field-count <>)
    1275        field-getters) ) ) )
     1606; The MySQL Field structure multi-slot API.
     1607
     1608; returns a list of field items.
     1609(define (mysql-field-slots fldptr . getters)
     1610  (and fldptr
     1611       (map (cut <> fldptr) getters) ) )
     1612
     1613; returns a list of field items for nth field.
     1614(define (mysql-fetch-field-slots-direct conn nth . getters)
     1615  (apply mysql-field-slots (mysql-fetch-field-direct conn nth) getters) )
     1616
     1617; returns a field item for nth field.
     1618(define (mysql-fetch-field-slot-direct conn nth getter)
     1619  (and-let* ([lst (mysql-field-slots (mysql-fetch-field-direct conn nth) getter)])
     1620    (car lst) ) )
     1621
     1622; returns a list of field items for the next field.
     1623(define (mysql-fetch-field-slots conn . getters)
     1624  (apply mysql-field-slots (mysql-fetch-field conn) getters) )
     1625
     1626; returns a field item for the next field.
     1627(define (mysql-fetch-field-slot conn getter)
     1628  (and-let* ([lst (mysql-field-slots (mysql-fetch-field conn) getter)])
     1629    (car lst) ) )
  • release/3/mysql/trunk/mysql.setup

    r7902 r7925  
    2323  mysqlaux.c mysql.scm)
    2424
    25 (install-extension
    26   'mysql
     25(install-extension 'mysql
    2726  '("mysql.so" "mysql-mole.html")
    2827  `((version 1.3)
Note: See TracChangeset for help on using the changeset viewer.