source: project/release/3/mysql/trunk/mysql.scm @ 7926

Last change on this file since 7926 was 7926, checked in by Kon Lovett, 12 years ago

Bug fix for row map. Added test for fetch lengths.

File size: 54.8 KB
Line 
1; vim:ts=2:sw=2:et:
2
3;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4;; MySQL Egg for the Chicken Scheme system.
5;;
6;; mysql.scm,v 1.4 2005/08/04 10:09:26 tbutzon Exp
7;;
8;; Author: Toby Butzon (toby@butzon.com)
9;; Revisions:
10;;   2005.08.04 Initial release.
11;;   2007.01.20 Added -lz for Mac OS X compilation.
12;;                (Thanks to Daniel Sadilek.)
13;;              Changed #include <mysql/mysql.h> to #include <mysql.h>
14;;                (Thanks to Kon Lovett and Daniel Sadilek.)
15;;              Removed some misc. compilation warnings.
16;;                (Thanks to Kon Lovett.)
17;;              Added (error ...) calls instead of silently failing in
18;;                mysql-connect.
19;;                (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)
32;;
33;; This egg provides the MySQL C API via Chicken's foreign function
34;; interface. The function names in the MySQL C API are uniformly
35;; exported with "foreign-" prefixed to the name, and underscores are
36;; mapped to the more Scheme-ish dash; e.g., the MySQL C API's
37;; mysql_query is provided by this egg as foreign-mysql-query. Although
38;; these functions are exported, they are not verbosely documented in
39;; the egg documentation simply because the MySQL C API is already
40;; documented in full on MySQL's website:
41;;
42;;    http://dev.mysql.com/doc/mysql/en/c.html
43;;
44;; Further, this egg provides a layer on top of the foreign API to
45;; provide a simpler API that is appropriate to Scheme. These functions
46;; are _not_ prefixed with "foreign-" -- instead they are named according
47;; to the closest MySQL C API analog, if one exists. For example, the
48;; provided mysql-connect is briefer, yet provides the same functionality
49;; as, the C API sequence mysql_init, mysql_real_connect, and returns a
50;; Scheme-friendly record instead of a FFI C pointer.
51;;
52;; Please report bugs to <toby@butzon.com>.
53;;
54;; Copyright (c) 2005 Toby Butzon.
55;;
56;; Permission is hereby granted, free of charge, to any person obtaining a
57;; copy of this software and associated documentation files (the "Software"),
58;; to deal in the Software without restriction, including without limitation
59;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
60;; and/or sell copies of the Software, and to permit persons to whom the
61;; Software is furnished to do so, subject to the following conditions:
62;;
63;; The above copyright notice and this permission notice shall be included
64;; in all copies or substantial portions of the Software.
65;;
66;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
67;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
68;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
69;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
70;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
71;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
72;; OTHER DEALINGS IN THE SOFTWARE.
73;;
74;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75
76#>
77#include <mysql.h>
78#include "mysqlaux.h"
79<#
80
81(use srfi-1 srfi-4 srfi-12)
82(use lolevel)
83
84(require-for-syntax 'srfi-13)
85
86(define-for-syntax (c-name->scheme-name str)
87  (string-downcase (string-translate str "_" "-")) )
88
89(declare
90  (usual-integrations)
91  (generic)
92  (no-procedure-checks-for-usual-bindings)
93  (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!
100                mysql-field-db-set!
101                mysql-field-type-set!
102                mysql-field-charsetnr-set!
103                mysql-field-catalog-set!
104                mysql-field-org-name-set!
105                mysql-field-name-set!
106                mysql-field-def-set!
107                mysql-field-org-table-set!
108                mysql-field-table-set!
109                mysql-field-flags-set!
110                mysql-field-org-table
111                mysql-field-decimals-set!
112                mysql-field-def-length-set!
113                mysql-field-catalog-length-set!
114                mysql-field-db-length-set!
115                mysql-field-org-table-length-set!
116                mysql-field-table-length-set!
117                mysql-field-org-name-length-set!
118                mysql-field-name-length-set!
119                mysql-field-max-length-set!
120                mysql-field-length-set! )
121  (bound-to-procedure
122    mysql-error)
123  (export
124    ;; direct api
125    foreign-mysql-affected-rows
126    foreign-mysql-change-user
127    foreign-mysql-character-set-name
128    foreign-mysql-close
129    foreign-mysql-data-seek
130    foreign-mysql-debug
131    foreign-mysql-dump-debug-info
132    foreign-mysql-errno
133    foreign-mysql-error
134    foreign-mysql-escape-string
135    foreign-mysql-fetch-field
136    foreign-mysql-fetch-fields
137    foreign-mysql-fetch-field-direct
138    foreign-mysql-fetch-lengths
139    foreign-mysql-fetch-row
140    foreign-mysql-field-count
141    foreign-mysql-field-seek
142    foreign-mysql-field-tell
143    foreign-mysql-free-result
144                foreign-mysql-get-character-set-info
145    foreign-mysql-get-client-info
146    foreign-mysql-get-client-version
147    foreign-mysql-get-host-info
148                foreign-mysql-get-proto-info
149    foreign-mysql-get-server-info
150    foreign-mysql-get-server-version
151    foreign-mysql-hex-string
152    foreign-mysql-info
153    foreign-mysql-init
154    foreign-mysql-insert-id
155    foreign-mysql-kill
156    foreign-mysql-library-init
157    foreign-mysql-library-end
158    foreign-mysql-list-dbs
159    foreign-mysql-list-fields
160    foreign-mysql-list-processes
161    foreign-mysql-list-tables
162    foreign-mysql-num-fields
163    foreign-mysql-num-rows
164    foreign-mysql-options
165    foreign-mysql-ping
166    foreign-mysql-query
167    foreign-mysql-real-connect
168    foreign-mysql-real-escape-string
169    foreign-mysql-real-query
170    foreign-mysql-row-seek
171    foreign-mysql-row-tell
172    foreign-mysql-select-db
173    foreign-mysql-set-character-set
174    foreign-mysql-set-server-option
175    foreign-mysql-shutdown
176    foreign-mysql-sqlstate
177    foreign-mysql-ssl-set
178    foreign-mysql-stat
179    foreign-mysql-store-result
180    foreign-mysql-thread-id
181    foreign-mysql-use-result
182    foreign-mysql-warning-count
183    foreign-mysql-commit
184    foreign-mysql-rollback
185    foreign-mysql-autocommit
186    foreign-mysql-more-results
187    foreign-mysql-next-result
188
189    ;; scheme api
190    mysql-connection?
191    mysql-affected-rows
192    mysql-change-user
193    mysql-character-set-name
194    mysql-close ; customized
195    mysql-connect ; customized
196                #;mysql-data-seek ; omitted (low level)
197    mysql-debug
198    mysql-dump-debug-info
199    mysql-errno
200    mysql-error ; customized
201    mysql-escape-string ; customized
202                mysql-fetch-field
203                mysql-fetch-fields
204                mysql-fetch-field-direct
205                mysql-fetch-lengths ; customized
206    mysql-fetch-row ; customized
207    mysql-field-count
208                #;mysql-field-seek ; omitted (low level)
209                #;mysql-field-tell ; omitted (low level)
210    mysql-free-result
211                mysql-get-character-set-info
212    mysql-get-client-info
213    mysql-get-client-version
214    mysql-get-host-info
215                mysql-get-proto-info
216    mysql-get-server-info
217    mysql-get-server-version
218                #;mysql-hex-string ; omitted (too new)
219    mysql-info
220                #;mysql-init ; omitted (low level)
221    mysql-insert-id
222    mysql-kill
223                #;mysql-library-init ; omitted (too new)
224                #;mysql-library-end ; omitted (too new)
225    mysql-list-dbs
226                mysql-list-fields ; (nearly deprecated)
227    mysql-list-processes
228    mysql-list-tables
229    mysql-num-fields
230    mysql-num-rows
231    mysql-ping
232    mysql-query
233                #;mysql-real-connect ; omitted (use mysql-connect)
234                #;mysql-real-escape-string ; omitted (use mysql-escape-string)
235                #;mysql-real-query ; omitted (use mysql-query)
236                #;mysql-row-seek ; omitted (low level)
237                #;mysql-row-tell ; omitted (low level)
238    mysql-select-db
239                mysql-set-character-set
240                #;mysql-set-server-option ; omitted (too new)
241                #;mysql-shutdown ; omitted (too new)
242                #;mysql-sqlstate ; omitted (too new)
243    mysql-stat
244    mysql-store-result
245    mysql-thread-id
246                #;mysql-use-result ; omitted (doesn't fit with Scheme layer; see mysql-query)
247                #;mysql-warning-count ; omitted (too new)
248                #;mysql-commit ; omitted (too new)
249                #;mysql-rollback ; omitted (too new)
250                #;mysql-autocommit ; omitted (too new)
251                #;mysql-more-results ; omitted (too new)
252                #;mysql-next-result ; omitted (too new)
253
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
263    ;; "extended" api
264    mysql-rewind
265
266    ;; "map" api
267    mysql-row-fold
268    mysql-row-for-each
269    mysql-row-map
270    mysql-query-fold
271    mysql-query-for-each
272    mysql-query-map
273    ; synonyms
274    mysql-foreach-row
275    mysql-query-foreach
276
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
294                mysql-field-name
295                mysql-field-org-name
296                mysql-field-table
297                mysql-field-org-table
298                mysql-field-db
299                mysql-field-catalog
300                mysql-field-def
301                mysql-field-length
302                mysql-field-max-length
303                mysql-field-name-length
304                mysql-field-org-name-length
305                mysql-field-table-length
306                mysql-field-org-table-length
307                mysql-field-db-length
308                mysql-field-catalog-length
309                mysql-field-def-length
310                mysql-field-flags
311                mysql-field-decimals
312                mysql-field-charsetnr
313                mysql-field-type
314
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
332    ;; enum enum_mysql_set_option
333    ; values
334    mysql-option-multi-statements-on
335    mysql-option-multi-statements-off
336                ; converters
337    mysql-server-option-value
338    mysql-server-option-symbol
339
340    ;; enum mysql_option
341    ; values
342    mysql-opt-connect-timeout
343    mysql-opt-compress
344    mysql-opt-named-pipe
345    mysql-init-command
346    mysql-read-default-file
347    mysql-read-default-group
348    mysql-set-charset-dir
349    mysql-set-charset-name
350    mysql-opt-local-infile
351    mysql-opt-protocol
352    mysql-shared-memory-base-name
353    mysql-opt-read-timeout
354    mysql-opt-write-timeout
355    mysql-opt-use-result
356    mysql-opt-use-remote-connection
357    mysql-opt-use-embedded-connection
358    mysql-opt-guess-connection
359    mysql-set-client-ip
360    mysql-secure-auth
361    mysql-report-data-truncation
362                ; converters
363    mysql-option-value
364    mysql-option-symbol
365
366    ;; enum enum_field_types
367    ; values
368        mysql-type-decimal
369        mysql-type-tiny
370        mysql-type-short
371        mysql-type-long
372        mysql-type-float
373        mysql-type-double
374        mysql-type-null
375        mysql-type-timestamp
376        mysql-type-longlong
377        mysql-type-int24
378        mysql-type-date
379        mysql-type-time
380        mysql-type-datetime
381        mysql-type-year
382        mysql-type-newdate
383        mysql-type-varchar
384        mysql-type-bit
385        mysql-type-newdecimal
386        mysql-type-enum
387        mysql-type-set
388        mysql-type-tiny-blob
389        mysql-type-medium-blob
390        mysql-type-long-blob
391        mysql-type-blob
392        mysql-type-var-string
393        mysql-type-string
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 ) )
418
419;=======================================================================
420; Interface to C API
421;
422; The entire C API is mapped using Chicken's foreign function interface.
423;
424
425;-----------------------------------------------------------------------
426; Foreign type definitions.
427;
428
429(define-foreign-type mysql-ptr (c-pointer "MYSQL"))
430(define-foreign-type mysql-res-ptr (c-pointer "MYSQL_RES"))
431(define-foreign-type mysql-rows-ptr (c-pointer "MYSQL_ROWS"))
432(define-foreign-type mysql-field-ptr (c-pointer "MYSQL_FIELD"))
433
434; mysql-row-ptr represents the C type MYSQL_ROW, which is actually a char**,
435; but we're just going to pass it to other mysql functions, hence the generic
436; c-pointer.
437(define-foreign-type mysql-row c-pointer)
438
439;-----------------------------------------------------------------------
440; Private enumeration value constants
441
442(define-foreign-enum (mysql-server-option (enum "enum_mysql_set_option"))
443  #f  ; No aliases!
444  MYSQL_OPTION_MULTI_STATEMENTS_ON
445  MYSQL_OPTION_MULTI_STATEMENTS_OFF )
446
447(define-foreign-enum (mysql-option (enum "mysql_option"))
448  #f  ; No aliases!
449  MYSQL_OPT_CONNECT_TIMEOUT
450  MYSQL_OPT_COMPRESS
451  MYSQL_OPT_NAMED_PIPE
452  MYSQL_INIT_COMMAND
453  MYSQL_READ_DEFAULT_FILE
454  MYSQL_READ_DEFAULT_GROUP
455  MYSQL_SET_CHARSET_DIR
456  MYSQL_SET_CHARSET_NAME
457  MYSQL_OPT_LOCAL_INFILE
458  MYSQL_OPT_PROTOCOL
459  MYSQL_SHARED_MEMORY_BASE_NAME
460  MYSQL_OPT_READ_TIMEOUT
461  MYSQL_OPT_WRITE_TIMEOUT
462  MYSQL_OPT_USE_RESULT
463  MYSQL_OPT_USE_REMOTE_CONNECTION
464  MYSQL_OPT_USE_EMBEDDED_CONNECTION
465  MYSQL_OPT_GUESS_CONNECTION
466  MYSQL_SET_CLIENT_IP
467  MYSQL_SECURE_AUTH
468  MYSQL_REPORT_DATA_TRUNCATION )
469
470(define-foreign-enum (mysql-type (enum "enum_field_types"))
471  #f  ; No aliases!
472  MYSQL_TYPE_DECIMAL
473        MYSQL_TYPE_TINY
474  MYSQL_TYPE_SHORT
475  MYSQL_TYPE_LONG
476  MYSQL_TYPE_FLOAT
477  MYSQL_TYPE_DOUBLE
478  MYSQL_TYPE_NULL
479  MYSQL_TYPE_TIMESTAMP
480  MYSQL_TYPE_LONGLONG
481  MYSQL_TYPE_INT24
482  MYSQL_TYPE_DATE
483  MYSQL_TYPE_TIME
484  MYSQL_TYPE_DATETIME
485        MYSQL_TYPE_YEAR
486  MYSQL_TYPE_NEWDATE
487        MYSQL_TYPE_VARCHAR
488  MYSQL_TYPE_BIT
489  MYSQL_TYPE_NEWDECIMAL
490  MYSQL_TYPE_ENUM
491  MYSQL_TYPE_SET
492  MYSQL_TYPE_TINY_BLOB
493  MYSQL_TYPE_MEDIUM_BLOB
494  MYSQL_TYPE_LONG_BLOB
495  MYSQL_TYPE_BLOB
496  MYSQL_TYPE_VAR_STRING
497  MYSQL_TYPE_STRING
498  MYSQL_TYPE_GEOMETRY )
499
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)
561  `(begin
562     ,@(map
563        (lambda (sym)
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
574  MYSQL_OPTION_MULTI_STATEMENTS_ON
575  MYSQL_OPTION_MULTI_STATEMENTS_OFF)
576
577(gen-public-enum mysql-option
578  MYSQL_OPT_CONNECT_TIMEOUT
579  MYSQL_OPT_COMPRESS
580  MYSQL_OPT_NAMED_PIPE
581  MYSQL_INIT_COMMAND
582  MYSQL_READ_DEFAULT_FILE
583  MYSQL_READ_DEFAULT_GROUP
584  MYSQL_SET_CHARSET_DIR
585  MYSQL_SET_CHARSET_NAME
586  MYSQL_OPT_LOCAL_INFILE
587  MYSQL_OPT_PROTOCOL
588  MYSQL_SHARED_MEMORY_BASE_NAME
589  MYSQL_OPT_READ_TIMEOUT
590  MYSQL_OPT_WRITE_TIMEOUT
591  MYSQL_OPT_USE_RESULT
592  MYSQL_OPT_USE_REMOTE_CONNECTION
593  MYSQL_OPT_USE_EMBEDDED_CONNECTION
594  MYSQL_OPT_GUESS_CONNECTION
595  MYSQL_SET_CLIENT_IP
596  MYSQL_SECURE_AUTH
597  MYSQL_REPORT_DATA_TRUNCATION)
598
599(gen-public-enum mysql-type
600  MYSQL_TYPE_DECIMAL
601        MYSQL_TYPE_TINY
602  MYSQL_TYPE_SHORT
603  MYSQL_TYPE_LONG
604  MYSQL_TYPE_FLOAT
605  MYSQL_TYPE_DOUBLE
606  MYSQL_TYPE_NULL
607  MYSQL_TYPE_TIMESTAMP
608  MYSQL_TYPE_LONGLONG
609  MYSQL_TYPE_INT24
610  MYSQL_TYPE_DATE
611  MYSQL_TYPE_TIME
612  MYSQL_TYPE_DATETIME
613        MYSQL_TYPE_YEAR
614  MYSQL_TYPE_NEWDATE
615        MYSQL_TYPE_VARCHAR
616  MYSQL_TYPE_BIT
617  MYSQL_TYPE_NEWDECIMAL
618  MYSQL_TYPE_ENUM
619  MYSQL_TYPE_SET
620  MYSQL_TYPE_TINY_BLOB
621  MYSQL_TYPE_MEDIUM_BLOB
622  MYSQL_TYPE_LONG_BLOB
623  MYSQL_TYPE_BLOB
624  MYSQL_TYPE_VAR_STRING
625  MYSQL_TYPE_STRING
626  MYSQL_TYPE_GEOMETRY)
627
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
787;-----------------------------------------------------------------------
788; Foreign function definitions from MySQL C API.
789;
790; I've copied the listing of MySQL C API functions straight from the
791; MySQL manual. They are in alphabetical order, exactly as they appear
792; in the manual. Further, the C function signature is copied below the
793; manual entry. Finally, the Scheme foreign lambda mapping follows the
794; C function signature.
795;
796
797; just to be specific
798(define-foreign-type my-bool bool)
799
800; 24.2.3.2. mysql_change_user()
801; my_bool mysql_change_user(MYSQL *mysql, const char *user,
802;   const char *password, const char *db)
803(define foreign-mysql-change-user
804  (foreign-lambda my-bool "mysql_change_user" mysql-ptr c-string c-string
805                  c-string))
806
807; 24.2.3.3. mysql_character_set_name()
808; const char *mysql_character_set_name(MYSQL *mysql)
809(define foreign-mysql-character-set-name
810  (foreign-lambda c-string "mysql_character_set_name" mysql-ptr))
811
812; 24.2.3.4. mysql_close()
813; void mysql_close(MYSQL *mysql)
814(define foreign-mysql-close
815  (foreign-lambda void "mysql_close" mysql-ptr))
816
817; 24.2.3.8. mysql_debug()
818; void mysql_debug(const char *debug)
819(define foreign-mysql-debug
820  (foreign-lambda void "mysql_debug" c-string))
821
822; 24.2.3.10. mysql_dump_debug_info()
823; int mysql_dump_debug_info(MYSQL *mysql)
824(define foreign-mysql-dump-debug-info
825  (foreign-lambda integer "mysql_dump_debug_info" mysql-ptr))
826
827; 24.2.3.12. mysql_errno()
828; unsigned int mysql_errno(MYSQL *mysql)
829(define foreign-mysql-errno
830  (foreign-lambda unsigned-integer "mysql_errno" mysql-ptr))
831
832; 24.2.3.13. mysql_error()
833; const char *mysql_error(MYSQL *mysql)
834(define foreign-mysql-error
835  (foreign-lambda c-string "mysql_error" mysql-ptr))
836
837; 24.2.3.14. mysql_escape_string()
838; unsigned long mysql_escape_string(char *to, const char *from,
839;   unsigned long length)
840(define foreign-mysql-escape-string
841  (foreign-lambda unsigned-long "mysql_escape_string" c-string c-string
842                  unsigned-long))
843
844; 24.2.3.15. mysql_fetch_field()
845; MYSQL_FIELD *mysql_fetch_field(MYSQL_RES *result)
846(define foreign-mysql-fetch-field
847  (foreign-lambda mysql-field-ptr "mysql_fetch_field" mysql-res-ptr))
848
849; 24.2.3.16. mysql_fetch_fields()
850; MYSQL_FIELD *mysql_fetch_fields(MYSQL_RES *result)
851(define foreign-mysql-fetch-fields
852  (foreign-lambda mysql-field-ptr "mysql_fetch_fields" mysql-res-ptr))
853
854; 24.2.3.17. mysql_fetch_field_direct()
855; MYSQL_FIELD *mysql_fetch_field_direct(MYSQL_RES *result, unsigned int fieldnr)
856(define foreign-mysql-fetch-field-direct
857  (foreign-lambda mysql-field-ptr "mysql_fetch_field_direct" mysql-res-ptr
858                  unsigned-integer))
859
860; 24.2.3.18. mysql_fetch_lengths()
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))
864
865; 24.2.3.19. mysql_fetch_row()
866; MYSQL_ROW mysql_fetch_row(MYSQL_RES *result)
867(define foreign-mysql-fetch-row
868  (foreign-lambda mysql-row "mysql_fetch_row" mysql-res-ptr))
869
870; 24.2.3.20. mysql_field_count()
871; unsigned int mysql_field_count(MYSQL *mysql)
872(define foreign-mysql-field-count
873  (foreign-lambda unsigned-integer "mysql_field_count" mysql-ptr))
874
875; 24.2.3.21. mysql_field_seek()
876; MYSQL_FIELD_OFFSET mysql_field_seek(MYSQL_RES *result,
877;   MYSQL_FIELD_OFFSET offset)
878(define foreign-mysql-field-seek
879  (foreign-lambda unsigned-integer "mysql_field_seek" mysql-res-ptr
880                  unsigned-integer))
881
882; 24.2.3.22. mysql_field_tell()
883; MYSQL_FIELD_OFFSET mysql_field_tell(MYSQL_RES *result)
884(define foreign-mysql-field-tell
885  (foreign-lambda unsigned-integer "mysql_field_tell" mysql-res-ptr))
886
887; 24.2.3.23. mysql_free_result()
888; void mysql_free_result(MYSQL_RES *result)
889(define foreign-mysql-free-result
890  (foreign-lambda void "mysql_free_result" mysql-res-ptr))
891
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))
896
897; 24.2.3.25. mysql_get_client_info()
898; char *mysql_get_client_info(void)
899(define foreign-mysql-get-client-info
900  (foreign-lambda c-string "mysql_get_client_info"))
901
902; 24.2.3.26. mysql_get_client_version()
903; unsigned long mysql_get_client_version(void)
904(define foreign-mysql-get-client-version
905  (foreign-lambda unsigned-long "mysql_get_client_version"))
906
907; 24.2.3.27. mysql_get_host_info()
908; char *mysql_get_host_info(MYSQL *mysql)
909(define foreign-mysql-get-host-info
910  (foreign-lambda c-string "mysql_get_host_info" mysql-ptr))
911
912; 24.2.3.28. mysql_get_proto_info()
913; unsigned int mysql_get_proto_info(MYSQL *mysql)
914(define foreign-mysql-get-proto-info
915  (foreign-lambda unsigned-integer "mysql_get_proto_info" mysql-ptr))
916
917; 24.2.3.29. mysql_get_server_info()
918; char *mysql_get_server_info(MYSQL *mysql)
919(define foreign-mysql-get-server-info
920  (foreign-lambda c-string "mysql_get_server_info" mysql-ptr))
921
922; 24.2.3.30. mysql_get_server_version()
923; unsigned long mysql_get_server_version(MYSQL *mysql)
924(define foreign-mysql-get-server-version
925  (foreign-lambda unsigned-long "mysql_get_server_version" mysql-ptr))
926
927; 24.2.3.31. mysql_hex_string()
928; unsigned long mysql_hex_string(char *to, const char *from,
929;   unsigned long length)
930(define foreign-mysql-hex-string
931  (foreign-lambda unsigned-long "mysql_hex_string" c-string c-string
932                  unsigned-long))
933
934; 24.2.3.32. mysql_info()
935; char *mysql_info(MYSQL *mysql)
936(define foreign-mysql-info
937  (foreign-lambda c-string "mysql_info" mysql-ptr))
938
939; 24.2.3.33. mysql_init()
940; MYSQL *mysql_init(MYSQL *mysql)
941(define foreign-mysql-init
942  (foreign-lambda mysql-ptr "mysql_init" mysql-ptr))
943
944; 24.2.3.35. mysql_kill()
945; int mysql_kill(MYSQL *mysql, unsigned long pid)
946(define foreign-mysql-kill
947  (foreign-lambda integer "mysql_kill" mysql-ptr unsigned-long))
948
949; 24.2.3.36. mysql_library_init()
950; int mysql_library_init(int argc, char **argv, char **groups)
951(define foreign-mysql-library-init
952  (foreign-lambda integer "mysql_library_init" integer c-pointer c-pointer))
953
954; 24.2.3.37. mysql_library_end()
955; void mysql_library_end(void)
956(define foreign-mysql-library-end
957  (foreign-lambda void "mysql_library_end"))
958
959; 24.2.3.38. mysql_list_dbs()
960; MYSQL_RES *mysql_list_dbs(MYSQL *mysql, const char *wild)
961(define foreign-mysql-list-dbs
962  (foreign-lambda mysql-res-ptr "mysql_list_dbs" mysql-ptr c-string))
963
964; 24.2.3.39. mysql_list_fields()
965; MYSQL_RES *mysql_list_fields(MYSQL *mysql, const char *table,
966;   const char *wild)
967(define foreign-mysql-list-fields
968  (foreign-lambda mysql-res-ptr "mysql_list_fields" mysql-ptr c-string
969                  c-string))
970
971; 24.2.3.40. mysql_list_processes()
972; MYSQL_RES *mysql_list_processes(MYSQL *mysql)
973(define foreign-mysql-list-processes
974  (foreign-lambda mysql-res-ptr "mysql_list_processes" mysql-ptr))
975
976; 24.2.3.41. mysql_list_tables()
977; MYSQL_RES *mysql_list_tables(MYSQL *mysql, const char *wild)
978(define foreign-mysql-list-tables
979  (foreign-lambda mysql-res-ptr "mysql_list_tables" mysql-ptr c-string))
980
981; 24.2.3.42. mysql_num_fields()
982; unsigned int mysql_num_fields(MYSQL_RES *result)
983(define foreign-mysql-num-fields
984  (foreign-lambda unsigned-integer "mysql_num_fields" mysql-res-ptr))
985
986; 24.2.3.44. mysql_options()
987; int mysql_options(MYSQL *mysql, enum mysql_option option, const char *arg)
988(define foreign-mysql-options
989  (foreign-lambda integer "mysql_options" mysql-ptr mysql-option c-pointer))
990
991; 24.2.3.45. mysql_ping()
992; int mysql_ping(MYSQL *mysql)
993(define foreign-mysql-ping
994  (foreign-lambda integer "mysql_ping" mysql-ptr))
995
996; 24.2.3.46. mysql_query()
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))
1002
1003; 24.2.3.47. mysql_real_connect()
1004; MYSQL *mysql_real_connect(MYSQL *mysql, const char *host, const char *user,
1005;   const char *passwd, const char *db, unsigned int port,
1006;   const char *unix_socket, unsigned long client_flag)
1007(define foreign-mysql-real-connect
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))
1012
1013; 24.2.3.48. mysql_real_escape_string()
1014; unsigned long mysql_real_escape_string(MYSQL *mysql, char *to,
1015;   const char *from, unsigned long length)
1016(define foreign-mysql-real-escape-string
1017  (foreign-lambda unsigned-long "mysql_real_escape_string" mysql-ptr
1018                  c-string c-string unsigned-long))
1019
1020; 24.2.3.49. mysql_real_query()
1021; int mysql_real_query(MYSQL *mysql, const char *query, unsigned long length)
1022(define foreign-mysql-real-query
1023  (foreign-lambda unsigned-integer "mysql_real_query" mysql-ptr c-string
1024                  unsigned-long))
1025
1026; 24.2.3.51. mysql_row_seek()
1027; MYSQL_ROW_OFFSET mysql_row_seek(MYSQL_RES *result, MYSQL_ROW_OFFSET offset)
1028(define foreign-mysql-row-seek
1029  (foreign-lambda mysql-rows-ptr "mysql_row_seek" mysql-res-ptr mysql-rows-ptr))
1030
1031; 24.2.3.52. mysql_row_tell()
1032; MYSQL_ROW_OFFSET mysql_row_tell(MYSQL_RES *result)
1033(define foreign-mysql-row-tell
1034  (foreign-lambda mysql-rows-ptr "mysql_row_tell" mysql-res-ptr))
1035
1036; 24.2.3.53. mysql_select_db()
1037; int mysql_select_db(MYSQL *mysql, const char *db)
1038(define foreign-mysql-select-db
1039  (foreign-lambda integer "mysql_select_db" mysql-ptr c-string))
1040
1041; 24.2.3.54. mysql_set_character_set()
1042; int mysql_set_character_set(MYSQL *mysql, char *csname)
1043(define foreign-mysql-set-character-set
1044  (foreign-lambda integer "mysql_set_character_set" mysql-ptr c-string))
1045
1046; 24.2.3.55. mysql_set_server_option()
1047; int mysql_set_server_option(MYSQL *mysql, enum enum_mysql_set_option option)
1048(define foreign-mysql-set-server-option
1049  (foreign-lambda integer "mysql_set_server_option" mysql-ptr mysql-server-option))
1050
1051; 24.2.3.56. mysql_shutdown()
1052; int mysql_shutdown(MYSQL *mysql, enum enum_shutdown_level shutdown_level)
1053(define foreign-mysql-shutdown
1054  (foreign-lambda integer "mysql_shutdown" mysql-ptr integer))
1055
1056; 24.2.3.57. mysql_sqlstate()
1057; const char *mysql_sqlstate(MYSQL *mysql)
1058(define foreign-mysql-sqlstate
1059  (foreign-lambda c-string "mysql_sqlstate" mysql-ptr))
1060
1061; 24.2.3.58. mysql_ssl_set()
1062; int mysql_ssl_set(MYSQL *mysql, const char *key, const char *cert,
1063;   const char *ca, const char *capath, const char *cipher)
1064(define foreign-mysql-ssl-set
1065  (foreign-lambda integer "mysql_ssl_set" mysql-ptr c-string c-string
1066                  c-string c-string c-string))
1067
1068; 24.2.3.59. mysql_stat()
1069; char *mysql_stat(MYSQL *mysql)
1070(define foreign-mysql-stat
1071  (foreign-lambda c-string "mysql_stat" mysql-ptr))
1072
1073; 24.2.3.60. mysql_store_result()
1074; MYSQL_RES *mysql_store_result(MYSQL *mysql)
1075(define foreign-mysql-store-result
1076  (foreign-lambda mysql-res-ptr "mysql_store_result" mysql-ptr))
1077
1078; 24.2.3.61. mysql_thread_id()
1079; unsigned long mysql_thread_id(MYSQL *mysql)
1080(define foreign-mysql-thread-id
1081  (foreign-lambda unsigned-long "mysql_thread_id" mysql-ptr))
1082
1083; 24.2.3.62. mysql_use_result()
1084; MYSQL_RES *mysql_use_result(MYSQL *mysql)
1085(define foreign-mysql-use-result
1086  (foreign-lambda mysql-res-ptr "mysql_use_result" mysql-ptr))
1087
1088; 24.2.3.63. mysql_warning_count()
1089; unsigned int mysql_warning_count(MYSQL *mysql)
1090(define foreign-mysql-warning-count
1091  (foreign-lambda unsigned-integer "mysql_warning_count" mysql-ptr))
1092
1093; 24.2.3.64. mysql_commit()
1094; my_bool mysql_commit(MYSQL *mysql)
1095(define foreign-mysql-commit
1096  (foreign-lambda my-bool "mysql_commit" mysql-ptr))
1097
1098; 24.2.3.65. mysql_rollback()
1099; my_bool mysql_rollback(MYSQL *mysql)
1100(define foreign-mysql-rollback
1101  (foreign-lambda my-bool "mysql_rollback" mysql-ptr))
1102
1103; 24.2.3.66. mysql_autocommit()
1104; my_bool mysql_autocommit(MYSQL *mysql, my_bool mode)
1105(define foreign-mysql-autocommit
1106  (foreign-lambda my-bool "mysql_autocommit" mysql-ptr my-bool))
1107
1108; 24.2.3.67. mysql_more_results()
1109; my_bool mysql_more_results(MYSQL *mysql)
1110(define foreign-mysql-more-results
1111  (foreign-lambda my-bool "mysql_more_results" mysql-ptr))
1112
1113; 24.2.3.68. mysql_next_result()
1114; int mysql_next_result(MYSQL *mysql)
1115(define foreign-mysql-next-result
1116  (foreign-lambda integer "mysql_next_result" mysql-ptr))
1117
1118;-----------------------------------------------------------------------
1119; Foreign function definitions for mysqlaux functions.
1120;
1121
1122; char *mysqlaux_column_idx(MYSQL *, MYSQL_RES *, MYSQL_ROW, unsigned int);
1123(define foreign-mysqlaux-column-idx
1124  (foreign-lambda c-string "mysqlaux_column_idx" mysql-ptr mysql-res-ptr
1125                  mysql-row unsigned-integer))
1126
1127; char *mysqlaux_column_name(MYSQL *, MYSQL_RES *, MYSQL_ROW, const char *);
1128(define foreign-mysqlaux-column-name
1129  (foreign-lambda c-string "mysqlaux_column_name" mysql-ptr mysql-res-ptr
1130                  mysql-row nonnull-c-string))
1131
1132;=======================================================================
1133; Provided Scheme API.
1134;
1135; This is an attempt at a Schemer-friendly API to MySQL. Much of the API
1136; is the same, but the C API has been simplified where possible, and a
1137; few additional features have been layered on.
1138;
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) ) )
1199
1200;-----------------------------------------------------------------------
1201; MySQL "Connection" record type definition.
1202;
1203; I've stuffed the raw FFI pointer into a slot in the mysql-connection
1204; record. The record is here for a few reasons:
1205;
1206;   1) Instead of an ugly #<pointer>, I've defined a pretty printer
1207;      to demonstrate that we've actually got a MySQL connection.
1208;   2) The C API is somewhat more verbose than what normal usage would
1209;      need. (For example, usually you don't care whether results are
1210;      all read into memory as fast as possible, or if they're read from
1211;      the network one-by-one. Thus, the mysql-query function provided
1212;      automatically reads the results into memory. For finer granularity,
1213;      you're always free to write your own version to use the "raw"
1214;      foreign-* functions. I suppose a contribution to determine this
1215;      behavior via a (make-parameter ...) parameter may also be
1216;      accepted. ;)) Slots are provided in the mysql-connection record
1217;      type to allow for this sort of simplifying behavior.
1218;
1219; All of the "Scheme API" MySQL functions take instances of this record
1220; type, instead of a raw FFI pointer (as the foreign-* functions require).
1221;
1222
1223(define-record-type mysql-connection
1224  (make-mysql-connection host user passwd db port unix-socket
1225                         client-flag ptr result result-start
1226                         ssl opts)
1227  mysql-connection?
1228  (host mysql-connection-host)
1229  (user mysql-connection-user)
1230  (passwd mysql-connection-passwd)
1231  (db mysql-connection-db)
1232  (port mysql-connection-port)
1233  (unix-socket mysql-connection-unix-socket)
1234  (client-flag mysql-connection-client-flag)
1235  (ptr mysql-connection-ptr mysql-connection-ptr-set!)
1236  (result mysql-connection-result mysql-connection-result-set!)
1237  (result-start mysql-connection-result-start mysql-connection-result-start-set!)
1238  (ssl mysql-connection-ssl)
1239  (opts mysql-connection-options) )
1240
1241(define-record-printer (mysql-connection conn out)
1242  (let [(host (mysql-connection-host conn))
1243        (user (mysql-connection-user conn))
1244        (passwd (mysql-connection-passwd conn))
1245        (db (mysql-connection-db conn))
1246        (tcp-port (mysql-connection-port conn))
1247        (unix-socket (mysql-connection-unix-socket conn))
1248        (client-flag (mysql-connection-client-flag conn))
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) ) )
1268
1269;-----------------------------------------------------------------------
1270; The "base" MySQL/Scheme API.
1271;
1272; This part of the API provides a slightly simplified version of the full
1273; MySQL C API.
1274;
1275
1276(define (mysql-affected-rows conn)
1277  (foreign-mysql-affected-rows (mysql-connection-ptr conn)) )
1278
1279(define (mysql-change-user conn #!key (user #f) (passwd #f) (db #f))
1280  (foreign-mysql-change-user (mysql-connection-ptr conn) user passwd db) )
1281
1282(define (mysql-character-set-name conn)
1283  (foreign-mysql-character-set-name (mysql-connection-ptr conn)))
1284
1285; Closes a mysql connection and invalidates the mysql connection object.
1286; Returns (void). You should do this when you're done with the MySQL
1287; connection; however, if you don't close it manually, it will be closed
1288; upon termination.
1289(define (mysql-close conn)
1290  (mysql-free-result conn)
1291  (foreign-mysql-close (mysql-connection-ptr conn))
1292  (mysql-connection-ptr-set! conn #f) )
1293
1294; Returns a mysql connection object, or #f on failure.
1295(define (mysql-connect #!key (host #f) (user #f) (passwd #f) (db #f) (port 0)
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
1320              (make-mysql-connection host user passwd db port unix-socket
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") ] ) ) )
1327
1328(define (mysql-debug debug)
1329  (foreign-mysql-debug debug) )
1330
1331(define (mysql-dump-debug-info conn)
1332  (foreign-mysql-dump-debug-info (mysql-connection-ptr conn)) )
1333
1334(define (mysql-errno conn)
1335  (foreign-mysql-errno (mysql-connection-ptr conn)))
1336
1337; Returns a string describing the last mysql error, or #f if no error
1338; has occurred.
1339(define (mysql-error conn)
1340  (let [(errstr (foreign-mysql-error (mysql-connection-ptr conn)))]
1341    (and (not (string=? "" errstr))
1342         errstr) ) )
1343
1344(define (mysql-escape-string conn str)
1345        (let-location ([escstr c-string*])
1346    ((foreign-lambda* void ((mysql-ptr mysql) (c-pointer to) (c-string from) (unsigned-long length))
1347      "if ((*((char **) to) = ((char *) C_malloc ((2 * length) + 1)))) {\n"
1348      "    (void) mysql_real_escape_string (mysql, *((char **) to), from, length);\n"
1349      "}")
1350     (location escstr)
1351     str (string-length str))
1352    escstr ) )
1353
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(define (mysql-fetch-lengths conn)
1375  (and-let* ([resptr (mysql-connection-result conn)]
1376             [ulongptr (foreign-mysql-fetch-lengths resptr)])
1377    (let* ([siz (* (foreign-mysql-num-fields resptr) 4)]
1378           [store (make-blob siz)])
1379      (move-memory! ulongptr store siz)
1380      (blob->u32vector/shared store) ) ) )
1381
1382; After a mysql-query that has results, use mysql-fetch-row to retrieve
1383; results row-by-row. When no more rows are left, returns #f. When returning
1384; a "row", returns a procedure that takes exactly 1 argument, which may
1385; be either a number (in which case it is treated as the column index,
1386; starting at zero) or a symbol or string (which will be treated as the
1387; column name).
1388(define (mysql-fetch-row conn)
1389  (and-let* [(result (mysql-connection-result conn))]
1390    (let* [(row (foreign-mysql-fetch-row result))
1391           (connptr (mysql-connection-ptr conn))
1392           (row-lambda
1393            (lambda (field)
1394              (cond [(number? field)
1395                     (foreign-mysqlaux-column-idx connptr
1396                                                  result row field)]
1397                    [else
1398                     (foreign-mysqlaux-column-name connptr
1399                                                   result row (->string field))])))]
1400      (and row
1401           row-lambda ) ) ) )
1402
1403(define (mysql-field-count conn)
1404  (foreign-mysql-field-count (mysql-connection-ptr conn)))
1405
1406(define (mysql-free-result conn)
1407  (and-let* [(res (mysql-connection-result conn))]
1408    (foreign-mysql-free-result res) )
1409  (mysql-connection-result-set! conn #f)
1410  (mysql-connection-result-start-set! conn #f) )
1411
1412; returns a c-pointer to a MY_CHARSET_INFO struct.
1413; a finalizer is supplied.
1414(define (mysql-get-character-set-info conn)
1415  (let ([chrsetinfo (allocate-my-charset-info)])
1416    (foreign-mysql-get-character-set-info (mysql-connection-ptr conn) chrsetinfo)
1417    (set-finalizer! chrsetinfo free-my-charset-info)
1418    chrsetinfo ) )
1419
1420(define (mysql-get-client-info)
1421  (foreign-mysql-get-client-info) )
1422
1423(define (mysql-get-client-version)
1424  (foreign-mysql-get-client-version) )
1425
1426(define (mysql-get-host-info conn)
1427  (foreign-mysql-get-host-info (mysql-connection-ptr conn)) )
1428
1429;
1430(define (mysql-get-proto-info conn)
1431  (foreign-mysql-get-proto-info (mysql-connection-ptr conn)) )
1432
1433(define (mysql-get-server-info conn)
1434  (foreign-mysql-get-server-info (mysql-connection-ptr conn)) )
1435
1436(define (mysql-get-server-version conn)
1437  (foreign-mysql-get-server-version (mysql-connection-ptr conn)) )
1438
1439(define (mysql-info conn)
1440  (foreign-mysql-info (mysql-connection-ptr conn)) )
1441
1442(define (mysql-insert-id conn)
1443  (foreign-mysql-insert-id (mysql-connection-ptr conn)) )
1444
1445(define (mysql-kill conn pid)
1446  (foreign-mysql-kill (mysql-connection-ptr conn) pid) )
1447
1448(define (mysql-list-dbs conn like)
1449  (mysql-free-result conn)
1450  (mysql-connection-result-set! conn
1451    (foreign-mysql-list-dbs (mysql-connection-ptr conn) like)) )
1452
1453(define (mysql-list-fields conn table wild)
1454  (mysql-free-result conn)
1455  (mysql-connection-result-set! conn
1456    (foreign-mysql-list-fields (mysql-connection-ptr conn) table wild)) )
1457
1458(define (mysql-list-processes conn)
1459  (mysql-free-result conn)
1460  (mysql-connection-result-set! conn
1461    (foreign-mysql-list-processes (mysql-connection-ptr conn))) )
1462
1463(define (mysql-list-tables conn wild)
1464  (mysql-free-result conn)
1465  (mysql-connection-result-set! conn
1466    (foreign-mysql-list-tables (mysql-connection-ptr conn) wild)) )
1467
1468(define (mysql-num-fields conn)
1469  (foreign-mysql-num-fields (mysql-connection-result conn)) )
1470
1471(define (mysql-num-rows conn)
1472  (and-let* ([res (mysql-connection-result conn)])
1473    (foreign-mysql-num-rows res)) )
1474
1475(define (mysql-ping conn)
1476  (foreign-mysql-ping (mysql-connection-ptr conn)) )
1477
1478; returns #t if the query was successful, signals exception otherwise.
1479(define (mysql-query conn query)
1480  (let [(mysql-ptr (mysql-connection-ptr conn))]
1481    ; zero indicates success
1482    (if (zero? (foreign-mysql-real-query mysql-ptr query (string-length query)))
1483        (begin (mysql-store-result conn) #t)
1484        (signal-mysql-error 'mysql-query conn query) ) ) )
1485
1486; returns #t if the select was successful, signals exception otherwise.
1487(define (mysql-select-db conn db)
1488  (or (zero? (foreign-mysql-select-db (mysql-connection-ptr conn) db))
1489      (signal-mysql-error 'mysql-select-db conn db) ) )
1490
1491; returns #t if the set was successful, signals exception otherwise.
1492(define (mysql-set-character-set conn csname)
1493  (or (zero? (foreign-mysql-set-character-set (mysql-connection-ptr conn) csname))
1494      (signal-mysql-condition 'mysql-set-character-set "bad character set name" csname) ) )
1495
1496(define (mysql-stat conn)
1497  (foreign-mysql-stat (mysql-connection-ptr conn)) )
1498
1499(define (mysql-store-result conn)
1500  (mysql-connection-result-set! conn
1501    (foreign-mysql-store-result (mysql-connection-ptr conn)))
1502  (mysql-connection-result-start-set! conn
1503    (and (mysql-connection-result conn)
1504         (foreign-mysql-row-tell (mysql-connection-result conn))) ) )
1505
1506(define (mysql-thread-id conn)
1507  (foreign-mysql-thread-id (mysql-connection-ptr conn)) )
1508
1509;-----------------------------------------------------------------------
1510; The "extended" MySQL/Scheme API.
1511;
1512; This API provides some additional functionality.
1513;
1514
1515; rewinds to the beginning of the result set. has no effect if there is no
1516; current result set.
1517(define (mysql-rewind conn)
1518  (and-let* ([res-st (mysql-connection-result-start conn)])
1519    (foreign-mysql-row-seek (mysql-connection-result conn) res-st) ) )
1520
1521;-----------------------------------------------------------------------
1522; The "map" MySQL/Scheme API.
1523;
1524; This API provides some additional functionality for traversing results
1525; in a Scheme-ish way.
1526;
1527
1528; calls proc on every row in the current result set. proc should take 3
1529; arguments: the row (as described for mysql-fetch-row), the row index
1530; (which starts with 1 and ends with (mysql-num-rows conn), and the
1531; current accumulated value.
1532;
1533; returns the final accumulated value.
1534;
1535; note: rewinds the result set before and after iterating over it; thus,
1536; all rows are included.
1537;
1538; you must call mysql-rewind if you later want to iterate over the result set
1539; using mysql-fetch-row.
1540(define (mysql-row-fold conn proc init)
1541  (mysql-rewind conn)
1542  (let loop ([rownum 1] [acc init])
1543    (let ([row (mysql-fetch-row conn)])
1544      (if row
1545          (loop (+ rownum 1) (proc row rownum acc))
1546          acc ) ) ) )
1547
1548; calls proc on every row in the current result set. proc should take 2
1549; arguments: the row (as described for mysql-fetch-row) and the row index
1550; (which starts with 1 and ends with (mysql-num-rows conn).
1551;
1552; note: rewinds the result set before and after iterating over it; thus,
1553; all rows are included.
1554;
1555; you must call mysql-rewind if you later want to iterate over the result set
1556; using mysql-fetch-row.
1557(define (mysql-row-for-each conn proc)
1558  (mysql-row-fold conn
1559                  (lambda (row rownum _) (proc row rownum))
1560                  #t) )
1561
1562; calls proc on every row in the current result set. proc should take 2
1563; arguments: the row (as described for mysql-fetch-row) and the row index
1564; (which starts with 1 and ends with (mysql-num-rows conn).
1565;
1566; returns a list of the results of each proc invocation.
1567;
1568; note: rewinds the result set before and after iterating over it; thus,
1569; all rows are included.
1570;
1571; you must call mysql-rewind if you later want to iterate over the result set
1572; using mysql-fetch-row.
1573(define (mysql-row-map conn proc)
1574  (reverse!
1575    (mysql-row-fold conn
1576                    (lambda (row rownum lst) (cons (proc row rownum) lst))
1577                    '())) )
1578
1579; executes query and then mysql-row-for-each with the given proc. the proc
1580; must meet the contract specified for the proc passed to mysql-row-for-each.
1581(define (mysql-query-fold conn query proc init)
1582  (mysql-query conn query)
1583  (mysql-row-fold conn proc init) )
1584
1585; executes query and then mysql-row-for-each with the given proc. the proc
1586; must meet the contract specified for the proc passed to mysql-row-for-each.
1587(define (mysql-query-for-each conn query proc)
1588  (mysql-query conn query)
1589  (mysql-row-for-each conn proc) )
1590
1591; executes query and then mysql-row-for-each with the given proc. the proc
1592; must meet the contract specified for the proc passed to mysql-row-for-each.
1593(define (mysql-query-map conn query proc)
1594  (mysql-query conn query)
1595  (mysql-row-map conn proc) )
1596
1597; synonyms
1598(define mysql-query-foreach mysql-query-for-each)
1599(define mysql-foreach-row mysql-row-for-each)
1600
1601;-----------------------------------------------------------------------
1602; The MySQL Field structure multi-slot API.
1603
1604; returns a list of field items.
1605(define (mysql-field-slots fldptr . getters)
1606  (and fldptr
1607       (map (cut <> fldptr) getters) ) )
1608
1609; returns a list of field items for nth field.
1610(define (mysql-fetch-field-slots-direct conn nth . getters)
1611  (apply mysql-field-slots (mysql-fetch-field-direct conn nth) getters) )
1612
1613; returns a field item for nth field.
1614(define (mysql-fetch-field-slot-direct conn nth getter)
1615  (and-let* ([lst (mysql-field-slots (mysql-fetch-field-direct conn nth) getter)])
1616    (car lst) ) )
1617
1618; returns a list of field items for the next field.
1619(define (mysql-fetch-field-slots conn . getters)
1620  (apply mysql-field-slots (mysql-fetch-field conn) getters) )
1621
1622; returns a field item for the next field.
1623(define (mysql-fetch-field-slot conn getter)
1624  (and-let* ([lst (mysql-field-slots (mysql-fetch-field conn) getter)])
1625    (car lst) ) )
Note: See TracBrowser for help on using the repository browser.